module GalleryPage (make) where import BuilderQQ import Date import Info import qualified NsfwWarning import Control.Monad import Data.Foldable import Data.Function ((&)) import qualified Data.HashMap.Strict as HashMap import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.List (intersperse, sort, sortOn) import Data.Maybe import Data.Ord (Down (..)) import qualified Data.Text.Lazy as Lazy import System.FilePath (takeDirectory, joinPath, splitPath) make :: Text -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text make root ginfo infos = toLazyText $ make' root ginfo infos make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0 $0.nsfwScript $title $0.nsfwDialog

$title

rss back
|] where items = map (uncurry $ makeYearItems nsfw) infosByYear infosByYear :: [(Int, [(FilePath, Info)])] infosByYear = infos & filter (not . #unlisted . snd) & sortOn (Down . compareKeyFor nsfw . snd) & groupOnKey (\(_, i) -> #latestYear i nsfw) undir = joinPath (replicate (length (splitPath prefix)) "..") allTags = infos & concatMap (map (,1) . tagsFor nsfw . #second) & HashMap.fromListWith (+) & HashMap.toList & sort requireFilters = map (uncurry $ makeFilter "require" mempty) allTags excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags nsfw = #nsfw filters /= NoNsfw url = [b|$root/$prefix|] imagepath0 | (_, (p₀, i₀) : _) : _ <- infosByYear = getThumb (takeDirectory p₀) i₀ | otherwise = "/style/card.png" nsfw' = NsfwWarning.Gallery <$ guard nsfw nsfwScript = NsfwWarning.script nsfw' nsfwDialog = NsfwWarning.dialog nsfw' -- from @extra@ groupOnKey :: Eq k => (a -> k) -> [a] -> [(k, [a])] groupOnKey _ [] = [] groupOnKey f (x:xs) = (fx, x:yes) : groupOnKey f no where fx = f x (yes, no) = span (\y -> fx == f y) xs makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder makeFilter prefix initial tag count = [b|@0 |] where id' = [b|$prefix$&_$tag'|] tag' = escId tag checked = if HashSet.member tag initial then [b| checked|] else "" hidden = if count <= 1 then [b| hidden|] else "" makeYearItems :: Bool -- ^ nsfw -> Int -- ^ year -> [(FilePath, Info)] -> Builder makeYearItems nsfw year infos = [b|@0
  • $year' $0.items |] where items = map (uncurry $ makeItem nsfw) infos year' = show year & foldMap \c -> [b|$c|] makeItem :: Bool -> FilePath -> Info -> Builder makeItem nsfw file info@(Info {bg}) = [b|@0
  • |] where title = fromMaybe (#title info) $ #galleryTitle info dir = takeDirectory file thumb = getThumb dir info nsfw' = if nsfw && #anyNsfw info then [b| nsfw|] else "" tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info date = #latestDate info nsfw date' = formatTooltip date year' = #year date updated' = if #updated info nsfw then [b|true|] else [b|false|] bgStyle = case bg of Other col -> [b| style="background: $col"|]; _ -> "" tooltip = let upd = if #updated info nsfw then "updated " else "" :: Builder in [b|$title ($upd$date')|]