{-# LANGUAGE RecordWildCards #-} module GalleryPage (make) where import BuilderQQ import Date import Info import qualified NsfwWarning import TagTransforms import Control.Monad import Data.Foldable import Data.Function ((&)) import qualified Data.HashMap.Strict as HashMap 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 -> IndexInfo -> GalleryInfo -> [(FilePath, Info)] -> Lazy.Text make root iinfo ginfo infos = toLazyText $ make' root ginfo $ map (fmap $ transformInfoTags iinfo.tags) infos make' :: Text -> GalleryInfo -> [(FilePath, Info)] -> Builder make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b| $nsfwScript $title $nsfwDialog

$title

rss back
$items
|] where items = map (uncurry $ makeYearItems nsfw) infosByYear infosByYear :: [(Int, [(FilePath, Info)])] infosByYear = infos & filter (not . (.unlisted) . snd) & sortOn (Down . compareKeyFor nsfw . snd) & groupOnKey (\(_, i) -> latestYearFor nsfw i) undir = joinPath (replicate (length (splitPath prefix)) "..") allTags = infos & concatMap (map (,1) . HashSet.toList . tagsFor nsfw . snd) & HashMap.fromListWith (+) & HashMap.toList & sort requireFilters = map (uncurry $ makeFilter "require" mempty) allTags excludeFilters = map (uncurry $ makeFilter "exclude" hidden) allTags nsfw = filters.nsfw /= NoNsfw url = [b|$root/$prefix|] 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| |] 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|

$year'

$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|
$title
|] where title = escAttr $ fromMaybe info.title info.galleryTitle dir = takeDirectory file thumbnail = getThumb dir info nsfw' = if nsfw && anyNsfw info then [b|$& nsfw|] else "" tags' = fold $ intersperse ";" $ map fromText $ sort $ HashSet.toList $ tagsFor nsfw info date = latestDateFor nsfw info date' = formatTooltip date year' = date.year updated' = if hasUpdatesFor nsfw info then [b|true|] else [b|false|] bgStyle = case bg of Other col -> [b|$& style="background: $col"|]; _ -> "" tooltip = [b|$title ($upd$date')|] where upd = if hasUpdatesFor nsfw info then "updated " else "" :: Builder