{-# 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
    ) 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)

defGemfeed :: Template
defGemfeed :: Template
defGemfeed =
    Text -> Template
template (Text -> Template) -> ([Text] -> Text) -> [Text] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\CR") ([Text] -> Template) -> [Text] -> Template
forall a b. (a -> b) -> a -> b
$
        [ Text
"# {$title$}"
        , Text
""
        , Text
"{$entries$}"
        ]

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

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

defAtomEntry :: Template
defAtomEntry :: Template
defAtomEntry =
    Text -> Template
template (Text -> Template) -> ([Text] -> Text) -> [Text] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\LF" ([Text] -> Template) -> [Text] -> Template
forall a b. (a -> b) -> a -> b
$
        [ Text
"<entry>"
        , Text
"  <title>{&title:fname:Post&}</title>"
        , Text
"  <link rel=\"alternate\" type=\"text/gemini\" href=\"{$url$}\" />"
        , Text
"  <updated>{$modified$}</updated>"
        , Text
"  <id>{$url$}</id>"
        , Text
"  <summary type=\"text\">{&summary:title:No summary given.&}</summary>"
        , Text
"  <content type=\"text/gemini\" src=\"{$url$}\"></content>"
        , Text
"</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 :: [Values] -> Values
lastModified [Values]
posts = case Values -> Maybe UTCTime
parseModified (Values -> Maybe UTCTime)
-> ([Values] -> Maybe Values) -> [Values] -> Maybe UTCTime
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Values] -> Maybe Values
forall a. [a] -> Maybe a
listToMaybe ([Values] -> Maybe Values)
-> ([Values] -> [Values]) -> [Values] -> Maybe Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Values] -> [Values]
sortPosts ([Values] -> Maybe UTCTime) -> [Values] -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ [Values]
posts of
    Maybe UTCTime
Nothing -> Values
forall k v. HashMap k v
M.empty
    Just UTCTime
modified ->
        let modifiedStr :: Text
modifiedStr = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> String
forall t. ISO8601 t => t -> String
iso8601Show (ZonedTime -> String)
-> (UTCTime -> ZonedTime) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
utc (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime
modified
            modifiedDate :: Text
modifiedDate = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
forall t. ISO8601 t => t -> String
iso8601Show (Day -> String) -> (UTCTime -> Day) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime
modified
         in [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Text
"modified", Text
modifiedStr), (Text
"modified_date", Text
modifiedDate)]

-- | Sorts the posts by the last modified.
sortPosts :: [Values] -> [Values]
sortPosts :: [Values] -> [Values]
sortPosts = (Values -> Values -> Ordering) -> [Values] -> [Values]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Values
a Values
b -> Maybe UTCTime -> Maybe UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Values -> Maybe UTCTime
parseModified Values
b) (Values -> Maybe UTCTime
parseModified Values
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 :: Bool -> Values -> Values
escapeFeed Bool
gemfeed = (Text -> Text -> Text) -> Values -> Values
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.mapWithKey Text -> Text -> Text
escape
  where
    escape :: Text -> Text -> Text
escape Text
key Text
value
        | Text
"url" Text -> Text -> Bool
`T.isSuffixOf` Text
key = Text -> Text
escapeLink Text
value
        | Text
"base" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key = Text -> Text
escapeLink Text
value
        | Text
"entries" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key = Text
value
        | Bool
otherwise = Bool -> (Text -> Text) -> Text -> Text
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Bool -> Bool
not Bool
gemfeed) Text -> Text
escapeContent Text
value

-- Ampersand encode given text minimally.
escapeContent :: Text -> Text
escapeContent :: Text -> Text
escapeContent = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
">" Text
"&gt;" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"<" Text
"&lt;" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"&" Text
"&amp;"

-- Percent encode given text minimally.
escapeLink :: Text -> Text
escapeLink :: Text -> Text
escapeLink = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"%20" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"`" Text
"%60" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"%27" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"%22"

-- Get the time modified of the given post.
parseModified :: Values -> Maybe UTCTime
parseModified :: Values -> Maybe UTCTime
parseModified = (ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> UTCTime
zonedTimeToUTC (Maybe ZonedTime -> Maybe UTCTime)
-> (String -> Maybe ZonedTime) -> String -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe ZonedTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe UTCTime)
-> (Values -> Maybe String) -> Values -> Maybe UTCTime
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> String) -> Maybe Text -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack (Maybe Text -> Maybe String)
-> (Values -> Maybe Text) -> Values -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Values -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
"modified"