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) 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 data 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 artistTag = ifJust artist makeArtist let formattedDate = formatLong date let buttonBar = makeButtonBar title $ addIds images let image0@(Image {path = path0, download = download0'}) : otherImages = #all images let download0 = fromMaybe (bigFile path0) download0' let path0' = pageFile path0 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 = ifJust bg \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

$artistTag

$formattedDate $updateDate

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

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 (cls :: Text) inner = [b|@0 |] makeCat lbl imgs = [b|@0

$lbl

$0.alts
|] where alts = makeAlts imgs makeAlts imgs = [b|@0 |] where elems = map (\(img,i) -> altButton img i) imgs 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