module SinglePage (make) where
import Info hiding (Text)
import Control.Exception
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder
import Data.Time (formatTime, defaultTimeLocale)
import Data.Maybe (fromMaybe)
import qualified Data.Char as Char
import qualified Data.List as List
-- | 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 -> Info -> Lazy.Text
make includeNsfw = toLazyText . make' includeNsfw
make' :: Bool -> Info -> Builder
make' includeNsfw (Info {date, title, tags, description, images, links}) =
"\n" <>
"\n" <>
"\n" <>
"\n\n" <>
ifJust title (\t -> "" <> esc t <> "\n\n") <>
"\n" <>
ifJust title (\t -> " " <> esc t <> "
\n") <>
" " <> formatDate date <> "
\n" <>
buttonBar title' includeNsfw images <>
"\n\n" <>
"\n" <>
" ![](\"")
path0 <> "\">\n" <>
ifJust description (\d ->
" \n" <>
"
description
\n" <>
indent 4 d <>
" \n") <>
extLinks includeNsfw links <>
"\n\n" <>
"\n"
where
path0' = let Image {path} = head images in path
path0 = fromText path0'
title' = fromMaybe path0' title
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
ifJust x f = maybe mempty f x
esc :: Strict.Text -> Builder
esc = foldMap esc1 . Strict.unpack where
esc1 '<' = "<"
esc1 '>' = ">"
esc1 '&' = "&"
esc1 '"' = """
esc1 '\'' = "&squot;"
esc1 c = singleton c
formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y"
buttonBar :: Strict.Text -> Bool -> [Image] -> Builder
buttonBar title includeNsfw allImages =
if null images then
throw $ NoEligibleImages title
else if length images == 1 then
mempty
else
" \n"
where
images | includeNsfw = allImages
| otherwise = filter (\Image {nsfw} -> not nsfw) allImages
iimages = zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) =
" nsfwClass <> ">\n" <>
" checked <> "id=\"" <> idLabel <> "\" " <>
"name=variant autocomplete=off\n" <>
" value=\"" <> fromText path <> "\">\n" <>
" \n"
where
nsfwClass = if nsfw then " class=nsfw" else ""
checked = if i == 0 then "checked " else ""
idLabel = escId label
escId :: Strict.Text -> Builder
escId = foldMap esc1 . Strict.unpack where
esc1 c
| Char.isSpace c = ""
| c < 'ΓΏ' && not (Char.isAlphaNum c || c == '-') = "_"
| otherwise = singleton c
indent :: Int -> Strict.Text -> Builder
indent n txt = spaces <> go (Strict.unpack txt) where
go "" = mempty
go "\n" = "\n"
go ('\n':cs) = singleton '\n' <> spaces <> go cs
go (c:cs) = singleton c <> go cs
spaces = fromString $ replicate n ' '
extLinks :: Bool -> [Link] -> Builder
extLinks includeNsfw links =
let links' =
if includeNsfw then links
else filter (\Link {nsfw} -> not nsfw) links in
if null links' then mempty else
" \n" <>
"
links
\n" <>
"
\n" <>
foldMap extLink links' <>
"
\n" <>
"