module SinglePage (make) where
import Date
import Info
import BuilderQQ
import Records ()
import qualified NsfwWarning
import Control.Exception
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath, (>))
import qualified System.Process as Proc
import Text.Read (readMaybe)
-- | 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
-> FilePath -- ^ gallery prefix
-> Bool -- ^ nsfw?
-> FilePath -- ^ data dir
-> FilePath -- ^ subdir of datadir containing this @info.yaml@
-> Info -> IO Lazy.Text
make root prefix nsfw dataDir dir info =
toLazyText <$> make' root prefix nsfw dataDir dir info
make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
make' root prefix nsfw dataDir dir
info@(Info {date, title, artist, bg, updates}) = do
images <- withSizes (dataDir > dir) $ imagesFor nsfw info
let undir = joinPath (replicate (length (splitPath dir)) "..")
let artistTag = ifJust artist makeArtist
let formattedDate = formatLong date
let buttonBar = makeButtonBar title images
let (image0@(Image {path = path0, download = download0'}),
Size {width = width0, height = height0})
= head images
let download0 = fromMaybe 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 updatesList = makeUpdates $ Map.toList updates
let makePrefetch (Image {path}) = [b||]
let prefetches = map (makePrefetch . #first) $ tail images
let makeWarning w = [b|@0
updated $u|]
let nsfwScript = NsfwWarning.script nsfw
let nsfwDialog = NsfwWarning.dialog nsfw
pure [b|@0
$nsfwScript
$bgStyle
$0.prefetches