module SinglePage (make) where import Info import BuilderQQ import Records () import Control.Exception import Data.Maybe (fromMaybe) import qualified Data.Text as Strict import qualified Data.Text.Lazy as Lazy import qualified Data.Time.Calendar as Time 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}) = do images <- withSizes (dataDir dir) $ imagesFor nsfw info let undir = joinPath (replicate (length (splitPath dir)) "..") let artistTag = ifJust artist makeArtist let formattedDate = formatDate 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 makePrefetch (Image {path}) = [b||] let prefetches = map (makePrefetch . #first) $ tail images let warning' = ifJust (#warning image0) \w -> [b|@4
cw: $w
|] 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 pure [b|@0 $bgStyle $0.prefetches $title

$title

$artistTag

$formattedDate

$buttonBar
$warning'
$descSection $tagsList $linksList
|] makeArtist :: Artist -> Builder makeArtist (Artist {name, url}) = [b|

by $artistLink

|] where artistLink = case url of Just u -> [b|$name|] Nothing -> [b|$name|] makeDesc :: Maybe Strict.Text -> Builder makeDesc mdesc = ifJust mdesc \desc -> [b|@4

about

$8.desc
|] makeButtonBar :: Strict.Text -> [(Image, Size)] -> Builder makeButtonBar title images = case length images of 0 -> throw $ NoEligibleImages title 1 -> "" _ -> [b|@0 |] where alts = map (\(i, (im, sz)) -> altButton i im sz) $ zip [0..] images altButton :: Int -> Image -> Size -> Builder altButton i (Image {label, path, nsfw, warning}) (Size {width, height}) = [b|@4 |] where nsfwClass = if nsfw then [b| class=nsfw|] else "" nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else "" checked = if i == 0 then [b| checked|] else "" idLabel = escId label path' = pageFile path warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|] makeTags :: FilePath -> [Strict.Text] -> Builder makeTags undir tags = if null tags then "" else [b|@4 |] where tagList = map makeTag tags makeTag tag = [b|
  • $tag|] where tag' = escId tag extLinks :: [Link] -> Builder extLinks links = if null links then "" else [b|@4 |] where linkList = map extLink links extLink :: Link -> Builder extLink (Link {title, url}) = [b|@8
  • $title |] formatDate :: Day -> Builder formatDate date = [b|$week $day $month $year|] where (year, month', day') = Time.toGregorian date week' = Time.dayOfWeek date day = nth day' month = Strict.words "january february march april may june july \ \august september october november december" !! (month' - 1) week = Strict.words "mon tue wed thu fri sat sun" !! (fromEnum week' - 1) nth :: Int -> Builder nth n = [b|$n$suf|] where suf | n >= 10, n <= 19 = [b|th|] | n `mod` 10 == 1 = [b|st|] | n `mod` 10 == 2 = [b|nd|] | n `mod` 10 == 3 = [b|rd|] | otherwise = [b|th|] data Size = Size {width, height :: !Int} deriving (Eq, Show) imageSize :: FilePath -> FilePath -> IO Size imageSize dir img = do -- "[0]" to get the first frame of an animation -- otherwise it prints a pair for each frame let filename = (dir img) ++ "[0]" output <- Proc.readProcess "identify" ["-format", "(%W,%H)", filename] "" case readMaybe output of Just (width, height) -> pure $ Size {width, height} Nothing -> fail $ "couldn't understand identify output:\n" ++ output withSizes :: FilePath -> [Image] -> IO [(Image, Size)] withSizes dir = traverse \img -> do size <- imageSize dir $ #path img pure (img, size)