Feed.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Gemoire.Gemlog.Feed
-- Copyright   :  (c) 2024 Sena
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  contact@sena.pink
-- Stability   :  stable
-- Portability :  portable
--
-- Feed related functions and default templates for gemlogs
--
-- The variables that are available to use in a feed template is not defined
-- here, as feeds need the whole gemlog. See `Gemoire.Gemlog' for the variables
-- available in the intended use.
module Gemoire.Gemlog.Feed
    ( -- * Utility functions
      sortPosts
    , lastModified
    , escapeFeed

      -- * Templates
    , defGemfeed
    , defGemfeedEntry
    , defAtom
    , defAtomEntry

      -- * Re-exports
    , vempty
    , vlist
    ) where

import Control.Monad ((<=<))
import Data.Function (applyWhen)
import qualified Data.HashMap.Strict as M
import Data.List (sortBy)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (UTCTime (utctDay), utc, utcToZonedTime, zonedTimeToUTC)
import Data.Time.Format.ISO8601 (iso8601ParseM, iso8601Show)

import Gemoire.Template (Template, Values, template, vempty, vlist)

defGemfeed :: Template
defGemfeed =
    template . T.unlines . map (<> "\CR") $
        [ "# {$title$}"
        , ""
        , "{$entries$}"
        ]

defGemfeedEntry :: Template
defGemfeedEntry = template "=> {$url$} {$modified_date$} - {&title:fname:Post&}"

defAtom :: Template
defAtom =
    template . T.unlines $
        [ "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
        , "<feed xmlns=\"http://www.w3.org/2005/Atom\">"
        , "  <title>{$title$}</title>"
        , "  <author>"
        , "    <name>{$author$}</name>"
        , "  </author>"
        , "  <link rel=\"self\" type=\"application/atom+xml\" href=\"{$url$}\" />"
        , "  <link rel=\"alternate\" type=\"text/gemini\" href=\"{$base$}\" />"
        , "  <generator uri=\"https://hackage.haskell.org/package/gemoire\">gemoire</generator>"
        , "  <updated>{$modified$}</updated>"
        , "  <id>{$url$}</id>"
        , ""
        , "{$entries$}"
        , ""
        , "</feed>"
        ]

defAtomEntry :: Template
defAtomEntry =
    template . T.intercalate "\LF" $
        [ "<entry>"
        , "  <title>{&title:fname:Post&}</title>"
        , "  <link rel=\"alternate\" type=\"text/gemini\" href=\"{$url$}\" />"
        , "  <updated>{$modified$}</updated>"
        , "  <id>{$url$}</id>"
        , "  <summary type=\"text\">{&summary:title:No summary given.&}</summary>"
        , "  <content type=\"text/gemini\" src=\"{$url$}\"></content>"
        , "</entry>"
        ]

-- | Takes the modified time and date of the latest post in the list,
-- in the form of a map of `Values' with the variables @modified@ and
-- @modified_date@, like in `Gemoire.Gemlog.Post.readPost'.
lastModified :: [Values] -> Values
lastModified posts = case parseModified <=< listToMaybe . sortPosts $ posts of
    Nothing -> vempty
    Just modified ->
        let modifiedStr = T.pack . iso8601Show . utcToZonedTime utc $ modified
            modifiedDate = T.pack . iso8601Show . utctDay $ modified
         in M.fromList [("modified", modifiedStr), ("modified_date", modifiedDate)]

-- | Sorts the posts by the last modified.
sortPosts :: [Values] -> [Values]
sortPosts = sortBy (\a b -> compare (parseModified b) (parseModified a))

-- | Escapes variables in feeds.
-- Only does bare minimum of encoding, enough to make the feed valid.
--
--     * Percent encodes the variable @base@ and those ending with @url@.
--     * Doesn't do anything to the variable @entries@.
--     * Ampersand encodes everything else /only for Atom feeds/.
escapeFeed
    :: Bool
    -- ^ Whether the feed is a gemfeed
    -> Values
    -> Values
escapeFeed gemfeed = M.mapWithKey escape
  where
    escape key value
        | "url" `T.isSuffixOf` key = escapeLink value
        | "base" == key = escapeLink value
        | "entries" == key = value
        | otherwise = applyWhen (not gemfeed) escapeContent value

-- Ampersand encode given text minimally.
escapeContent :: Text -> Text
escapeContent =
    T.replace ">" "&gt;"
        . T.replace "<" "&lt;"
        . T.replace "'" "&#39;"
        . T.replace "\"" "&quot;"
        . T.replace "&" "&amp;"

-- Percent encode given text minimally.
escapeLink :: Text -> Text
escapeLink = T.replace "'" "%27" . T.replace "\"" "%22"

-- Get the time modified of the given post.
parseModified :: Values -> Maybe UTCTime
parseModified = fmap zonedTimeToUTC . iso8601ParseM <=< fmap T.unpack . M.lookup "modified"