generator/Site/Feed.hs

   1 module Site.Feed where
   2
   3 import Data.Default (def)
   4 import Data.List qualified as List
   5 import Data.Map.Strict qualified as Map
   6 import Data.Time qualified as Time
   7 import PyF
   8 import Relude
   9 import Text.Atom.Feed qualified as Atom
  10 import Text.Blaze.Html5 ((!))
  11 import Text.Blaze.Html5 qualified as H
  12 import Text.Pandoc (runPure)
  13 import Text.Pandoc.Writers (writeHtml5String)
  14 import Prelude ()
  15
  16 import Site.Filter
  17 import Site.Lang
  18 import Site.Model
  19 import Site.Page
  20 import Site.Tag
  21 import Utils.Html
  22
  23 mkFeed :: Model -> Filter -> Atom.Feed
  24 mkFeed model filt@Filter{..} =
  25   ( Atom.nullFeed
  26       (absoluteLink model (Left ""))
  27       --(absoluteLink model (Right (RouteFilterAtom filt)))
  28       (Atom.TextString [fmt|{orgName} - {feedTitle filt}|])
  29       (atomTime . List.maximum . mapMaybe (metaUpdated . pageMeta) . Map.elems $ modelPosts model)
  30   )
  31     { Atom.feedAuthors =
  32         one
  33           Atom.nullPerson
  34             { Atom.personName = orgName
  35             , Atom.personEmail = Just [fmt|contact@{domainName}|]
  36             }
  37     , --, Atom.feedIcon = Just $ absoluteLink model (Left "static/img/feedIcon.png")
  38       Atom.feedEntries =
  39         [ feedEntry post
  40         | post@(_slug, Page{..}) <- filterPosts model filt
  41         , isJust $ metaUpdated pageMeta
  42         ]
  43     , Atom.feedLinks = one $ Atom.nullLink [fmt|https://{domainName}|]
  44     , Atom.feedCategories = Atom.newCategory . unTag <$> maybeToList filterTag
  45     }
  46   where
  47     atomTime = toText . Time.formatTime Time.defaultTimeLocale "%Y-%m-%d"
  48     feedEntry (pageName, Page{..}) =
  49       ( Atom.nullEntry
  50           pageLink
  51           (Atom.TextString $ metaTitle pageMeta)
  52           (atomTime (fromMaybe (error "Pages without date") $ metaUpdated pageMeta))
  53       )
  54         { Atom.entryCategories = Atom.newCategory . unTag <$> metaTags pageMeta
  55         , Atom.entryLinks = one $ Atom.nullLink pageLink
  56         , Atom.entrySummary = Atom.TextString . markdownText <$> metaSummary pageMeta
  57         , Atom.entryContent =
  58             Just $
  59               Atom.HTMLContent $
  60                 either (error . show) id $
  61                   runPure $ writeHtml5String def pageDoc
  62         }
  63       where
  64         pageLink = absoluteLink model $ Right $ RoutePage pageName
  65
  66 feedList :: Model -> H.Html
  67 feedList model = do
  68   H.h2 ! classes ["text-blue-800", "text-xl"] $ "Feed of all posts"
  69   H.table ! classes ["my-2", "table-fixed", "w-full"] $
  70     H.tr $ do
  71       icell ""
  72       forM_ (Nothing : (Just <$> [minBound ..])) $ \lang ->
  73         cell $ mkLink lang Nothing
  74   H.h2 ! classes ["text-blue-800", "text-xl"] $ "Feeds by tag"
  75   H.table ! classes ["my-2", "table-fixed", "w-full"] $ do
  76     forM_ (allTags model) $ \tag -> H.tr $ do
  77       icell (renderTag model True tag)
  78       forM_ (Nothing : (Just <$> [minBound ..])) $ \lang ->
  79         cell $ mkLink lang (Just tag)
  80   where
  81     mkLink lang tag =
  82       H.a
  83         ! classes
  84           [ "bg-gray-100"
  85           , "hover:underline"
  86           , "px-1"
  87           , "text-blue-800"
  88           ]
  89         ! hrefRoute model (RouteFilterAtom (Filter lang tag))
  90         $ maybe "Any" langText lang
  91     cell = H.td ! classes ["text-right", "w-1/4"]
  92     icell = H.td ! classes ["text-left", "w-1/4"]