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 :: 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" <> "
\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"