{-# LANGUAGE TransformListComp #-} module GalleryPage (make) where import BuilderQQ import Date import Info import qualified NsfwWarning import Control.Monad import Data.Foldable import Data.Function (on, (&)) import qualified Data.HashMap.Strict as HashMap import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.List (intersperse, groupBy, sortBy, sortOn) import qualified Data.Text.Lazy as Lazy import System.FilePath (takeDirectory, joinPath, splitPath) import GHC.Exts (Down (..), the) 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

$6.items

|] where items = map (uncurry $ makeYearItems nsfw) infosByYear infosByYear = [(the year, infopath) | infopath@(_, info) <- infos, not $ #unlisted info, then sortInfo by info, let year = #latestYear info nsfw, then group by Down year using groupBy'] sortInfo f = sortBy $ flip (compareFor nsfw `on` f) groupBy' f = groupBy ((==) `on` f) undir = joinPath (replicate (length (splitPath prefix)) "..") allTags = infos & concatMap (map (,1) . tagsFor nsfw . #second) & HashMap.fromListWith (+) & HashMap.toList & sortOn (\(tag, count) -> (Down count, tag)) requireFilters = map (uncurry $ makeFilter "require" mempty) allTags excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags nsfw = #nsfw filters /= NoNsfw url = [b|$root/$prefix|] imagepath0 | (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0 | otherwise = "/style/card.png" nsfw' = NsfwWarning.Gallery <$ guard nsfw nsfwScript = NsfwWarning.script nsfw' nsfwDialog = NsfwWarning.dialog nsfw' makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder makeFilter prefix initial tag count = [b|@0 $tag |] 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 {title, bg}) = [b|@0