module SinglePage (make) where import Date import Info import BuilderQQ import Records () import qualified NsfwWarning import Control.Exception import Control.Monad import Data.List (sort, intersperse) import Data.Maybe (fromMaybe, isNothing, isJust) import qualified Data.Text as Strict import qualified Data.Text.Lazy as Lazy import System.FilePath (joinPath, splitPath) import qualified Data.HashSet as Set import Data.Traversable -- | e.g. only nsfw images are present for a non-nsfw page newtype NoEligibleImages = NoEligibleImages {title :: Strict.Text} deriving stock Eq deriving anyclass Exception instance Show NoEligibleImages where show (NoEligibleImages {title}) = Strict.unpack title <> ": no images selected\n" <> " (probably a nsfw-only work without --nsfw set)" make :: Text -- ^ website root -> Text -- ^ website name -> FilePath -- ^ gallery prefix -> Bool -- ^ nsfw? -> FilePath -- ^ data dir -> FilePath -- ^ subdir of datadir containing this @info.yaml@ -> Info -> IO Lazy.Text make root siteName prefix nsfw dataDir dir info = toLazyText <$> make' root siteName prefix nsfw dataDir dir info make' :: Text -> Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder make' root siteName prefix nsfw _dataDir dir info@(Info {date, title, artist, bg}) = do let images = imagesFor nsfw info let undir = joinPath (replicate (length (splitPath dir)) "..") let formattedDate = formatLong date let buttonBar = makeButtonBar title $ addIds images let allImages = #all images let image0@(Image {path = path0, download = download0'}) = head allImages let otherImages = tail allImages let download0 = fromMaybe (bigFile path0) download0' let path0' = pageFile path0 let artistSection = makeArtist artist let descSection = makeDesc $ descFor nsfw info let tagsList = makeTags undir $ tagsFor nsfw info let linksList = extLinks $ linksFor nsfw info let updates = sort $ updatesFor nsfw info let updatesList = makeUpdates updates let makePrefetch (Image {path}) = [b||] where path' = bigFile path let prefetches = map makePrefetch otherImages let makeWarning w = [b|@0
$w
|] let defWarning = [b| i forgot to add a cw, sorry!
if you can let me know i'd appreciate it |] let warning' | Just w <- #warning image0 = makeWarning w | #nsfw image0 = makeWarning defWarning | otherwise = mempty let warningT = makeWarning [b|.|] let bgStyle = case bg of Default -> "" NoBorder -> [b|@0 |] Other col -> [b|@0 |] let url = [b|$root/$prefix/$dir|] let desc = case artist of Just (Artist {name}) -> [b|by $name|] Nothing -> "by niss" let thumb = getThumb "" info let updateDate = ifJust (last' updates) \(d, _) -> let updated = formatLong d in [b|
updated $updated|] let nsfw' = NsfwWarning.Single <$ guard nsfw let nsfwScript = NsfwWarning.script nsfw' let nsfwDialog = NsfwWarning.dialog nsfw' let imageMeta = if #sfw image0 && isNothing (#warning image0) then [b|@0 |] else [b|@0 |] pure [b|@0 $imageMeta $nsfwScript $bgStyle $0.prefetches $title $nsfwDialog

$title

$formattedDate $updateDate

back to gallery

$2.buttonBar
$warning'
$6.artistSection $6.descSection $6.updatesList $6.linksList $6.tagsList
|] last' :: [a] -> Maybe a last' xs = if null xs then Nothing else Just $ last xs makeArtist :: Maybe Artist -> Builder makeArtist Nothing = "" makeArtist (Just (Artist {name, url})) = [b|@0

by

$artistLink
|] where artistLink = case url of Just u -> [b|$name|] Nothing -> [b|$name|] makeDesc :: Desc -> Builder makeDesc NoDesc = "" makeDesc (TextDesc desc) = [b|@0

about

$4.desc
|] makeDesc (LongDesc fs) = [b|@0
$2.fields
|] where fields = map makeField fs makeField (DescField {name, text}) = [b|@0

$name

$4.text
|] addIds :: Traversable t => t Image -> t (Image, Text) addIds = snd . mapAccumL makeId Set.empty where makeId used img = (Set.insert newId used, (img, newId)) where newId = head $ filter (\i -> not $ i `Set.member` used) ids ids = [toStrictText [b|$label$i|] | i <- "" : map show [0::Int ..]] label = escId $ #label img makeButtonBar :: Strict.Text -> Images' (Image, Text) -> Builder makeButtonBar title images = case images of Uncat [] -> throw $ NoEligibleImages title Uncat [_] -> "" Cat [(_,[_])] -> "" Uncat imgs -> makeNav "uncat" $ makeAlts imgs Cat cats | all ((<= 1) . length . snd) cats -> makeButtonBar title $ Uncat $ flatten cats | [(_, imgs)] <- cats -> makeButtonBar title (Uncat imgs) | otherwise -> makeNav "cat" $ map (uncurry makeCat) cats where makeNav :: CanBuild b => Text -> b -> Builder makeNav cls inner = [b|@0 |] makeCat lbl imgs = [b|@0

$lbl

$0.alts
|] where alts = makeAlts imgs makeAlts imgs = [b|@0 |] where elems = map (uncurry altButton) imgs skipAll = if any (isJust . #warning . fst) images then [b|@0
|] else "" flatten :: [(Text, [(Image, a)])] -> [(Image, Text)] flatten cats = addIds [(img {label = cat}) | (cat, is) <- cats, (img, _) <- is] altButton :: Image -> Text -> Builder altButton img i = [b|@0 |] where Image {label, path, nsfw, warning, download} = img nsfwClass = if nsfw then [b| class=nsfw|] else "" nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else "" path' = pageFile path link = fromMaybe (bigFile path) download warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|] makeTags :: FilePath -> [Strict.Text] -> Builder makeTags undir tags = if null tags then "" else [b|@0 |] where tagList = map makeTag tags makeTag tag = [b|
  • $tag|] where tag' = escId tag extLinks :: [Link] -> Builder extLinks links = if null links then "" else [b|@0 |] where linkList = map extLink links extLink :: Link -> Builder extLink (Link {title, url}) = [b|@8
  • $title |] makeUpdates :: [(Date, [Update])] -> Builder makeUpdates ups = if all (null . snd) ups then "" else [b|@4

    updates

    $8.updateList
    |] where updateList = map (uncurry makeUpdate) ups makeUpdate :: Date -> [Update] -> Builder makeUpdate _ [] = "" makeUpdate date ups = [b|@8
    $date'
    $desc |] where date' = formatSlash date desc = mconcat $ map fromText $ intersperse "; " $ map #desc ups