{-# OPTIONS_GHC -fdefer-typed-holes #-}
module ImagePage
(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 :: Info -> Lazy.Text
make = toLazyText . make'
make' :: Info -> Builder
make' (Info {date, title, tags, description, images, links}) =
"\n" <>
"\n" <>
"\n" <>
"\n\n" <>
"" <> esc title <> "\n\n" <>
"\n" <>
" " <> esc title <> "
\n" <>
" " <> formatDate date <> "
\n" <>
" \n" <>
"\n\n" <>
"\n" <>
" ![](\"")
path0 <> "\">\n" <>
" \n" <>
indent 4 description <>
" \n\n" <>
" links
\n" <>
" \n" <>
foldMap extLink links <>
"
\n" <>
"\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"
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 ' '
extLink :: Link -> Builder
extLink (Link {title, url}) =
" \n" <>
" fromText url <> "\">\n" <>
" " <> fromText title <> "\n" <>
" \n"