module SinglePage (make) where
import Depend (pageFile)
import Info hiding (Text)
import BuilderQQ
import Records ()
import Control.Exception
import Control.Monad
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import Data.Time (formatTime, defaultTimeLocale)
import qualified Data.Char as Char
import qualified Data.List as List
import System.FilePath (joinPath, splitPath)
-- | 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 :: Bool -> FilePath -> Info -> Lazy.Text
make nsfw dir = toLazyText . make' nsfw dir
make' :: Bool -> FilePath -> Info -> Builder
make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
desc, nsfwDesc, images = allImages, links}) = [b|@0
$0.prefetches
$*title
$*title
$artistTag
$formattedDate
$buttonBar
$warning'
$descSection
$tagsList
$linksList
|]
where
artistTag = ifJust artist makeArtist
images | nsfw = allImages
| otherwise = filter #sfw allImages
formattedDate = formatDate date
buttonBar = makeButtonBar title images
image0 = head images
path0 = #path image0
download0 = fromMaybe path0 (#download image0)
path0' = pageFile path0
descSection = makeDesc nsfw desc nsfwDesc
tagsList = makeTags nsfw tags nsfwTags
linksList = extLinks nsfw links
prefetches = map makePrefetch $ tail images
makePrefetch (Image {path}) = [b||]
warning' = ifJust (#warning image0) \w -> [b|@4
cw: $*w
|]
undir = joinPath (replicate (length (splitPath dir)) "..")
makeArtist :: Artist -> Builder
makeArtist (Artist {name, url}) =
[b|by $artistLink
|]
where
artistLink = case url of
Just u -> [b|$*name|]
Nothing -> [b|$*name|]
makeDesc :: Bool -> Maybe Strict.Text -> Maybe Strict.Text -> Builder
makeDesc nsfw desc nsfwDesc = [b|@4
about
$8*desc'
$8*nsfwDesc'
|]
where
desc' = fromMaybe "" desc
nsfwDesc' = fromMaybe "" $ guard nsfw *> nsfwDesc
formatDate :: Day -> Builder
formatDate d =
let str = formatTime defaultTimeLocale "%e %#B %Y" d in [b|$@str|]
makeButtonBar :: Strict.Text -> [Image] -> Builder
makeButtonBar title images =
case length images of
0 -> throw $ NoEligibleImages title
1 -> ""
_ -> [b|@2
|]
where alts = map (uncurry altButton) $ zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw, warning}) = [b|@6
|]
where
nsfwClass = if nsfw then " class=nsfw" else ""
checked = if i == 0 then " checked" else ""
idLabel = escId label
path' = pageFile path
warning' = ifJust warning \w -> [b| data-warning="$*w"|]
escId :: Strict.Text -> Builder
escId = foldMap esc1 . Strict.unpack where
esc1 c
| Char.isSpace c = ""
| c < 'ΓΏ' && not (Char.isAlphaNum c || c == '-') = "_"
| otherwise = [b|$'c|]
makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder
makeTags nsfw sfwTags nsfwTags =
if null tags then "" else [b|@4
|]
where
tagList = map makeTag tags
makeTag t = [b|$*t|]
tags = List.nub $ if nsfw then sfwTags <> nsfwTags else sfwTags
extLinks :: Bool -> [Link] -> Builder
extLinks nsfw allLinks =
if null links then "" else [b|@4
|]
where
links = if nsfw then allLinks else filter #sfw allLinks
linkList = map extLink links
extLink :: Link -> Builder
extLink (Link {title, url}) = [b|@6
$*title
|]