{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where
import Control.Exception
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, sortOn)
import qualified Data.Text.Lazy as Lazy
import System.FilePath ((), takeDirectory, joinPath, splitPath)
import GHC.Exts (Down (..), the)
import BuilderQQ
import Depend (thumbFile)
import Info
newtype NoThumb = NoThumb FilePath
deriving stock Eq deriving anyclass Exception
instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
make :: GalleryInfo -> [(FilePath, Info)] -> Lazy.Text
make ginfo infos = toLazyText $ make' ginfo infos
make' :: GalleryInfo -> [(FilePath, Info)] -> Builder
make' (GalleryInfo {title, prefix, filters, hidden}) infos = [b|@0
$*title
|]
where
items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear =
[(the year, infopath) |
infopath@(_, info) <- infos,
then sortOn by Down info,
let year = #year info,
then group by Down year using groupBy']
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
makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
makeFilter prefix initial tag _count = [b|@8
|]
where
id' = [b|$*prefix$&_$tag'|]
tag' = escId tag
checked = if HashSet.member tag initial then " checked" else ""
makeYearItems :: Bool -- ^ nsfw
-> Integer -- ^ year
-> [(FilePath, Info)]
-> Builder
makeYearItems nsfw year infos = [b|@4
$year'
$4.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}) = [b|@4
$*title
|]
where
dir = takeDirectory file
thumb = maybe (throw $ NoThumb dir) (\t -> dir thumbFile t) $ #thumb info
nsfw' = if nsfw && #anyNsfw info then " nsfw" else ""
tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info