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, nsfwTags, 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\n" <> ifJust description (\d -> "
\n" <> "

description

\n" <> indent 4 d <> "
\n") <> "\n" <> makeTags includeNsfw tags nsfwTags <> 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 ' ' makeTags :: Bool -> [Strict.Text] -> [Strict.Text] -> Builder makeTags includeNsfw sfwTags nsfwTags = if null tags then mempty else "
\n" <> "

tags

\n" <> " \n" <> "
\n\n" where tags = List.nub $ if includeNsfw then sfwTags else sfwTags <> nsfwTags makeTag t = "
  • " <> fromText t <> "\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" <> "
    \n" extLink :: Link -> Builder extLink (Link {title, url}) = "
  • \n" <> " fromText url <> "\">\n" <> " " <> fromText title <> "\n" <> " \n"