module SinglePage (make) where
import Info hiding (Text)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder
import Data.Time (formatTime, defaultTimeLocale)
import qualified Data.Char as Char
import qualified Data.Vector as Vector
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" <>
"" <> esc title <> "\n\n" <>
"\n" <>
" " <> esc title <> "
\n" <>
" " <> formatDate date <> "
\n" <>
buttonBar includeNsfw images <>
"\n\n" <>
"\n" <>
" ![](\"")
path0 <> "\">\n" <>
" \n" <>
indent 4 description <>
" \n\n" <>
extLinks includeNsfw links <>
"\n\n" <>
"\n"
where
path0 = let Image {path} = Vector.head images in fromText path
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 :: Bool -> Vector Image -> Builder
buttonBar includeNsfw images =
let images' = if includeNsfw then images
else Vector.filter (\Image {nsfw} -> not nsfw) images in
if null images' then
error "not including nsfw but there are no sfw images!"
else if length images' == 1 then
mempty
else
" \n"
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 -> Vector Link -> Builder
extLinks includeNsfw links =
let links' =
if includeNsfw then links
else Vector.filter (\Link {nsfw} -> not nsfw) links in
if null links' then mempty else
" links
\n" <>
" \n" <>
foldMap extLink links' <>
"
\n"
extLink :: Link -> Builder
extLink (Link {title, url}) =
" \n" <>
" fromText url <> "\">\n" <>
" " <> fromText title <> "\n" <>
" \n"