    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell   #-}

    --------------------------------------------------------------------------------
    -- | A Module that allows easy rendering of RSS feeds.
    --
    -- The main rendering functions (@renderRss@, @renderAtom@) all assume that
    -- you pass the list of items so that the most recent entry in the feed is the
    -- first item in the list.
    --
    -- Also note that the context should have (at least) the following fields to
    -- produce a correct feed:
    --
    -- - @$title$@: Title of the item
    --
    -- - @$description$@: Description to appear in the feed
    --
    -- - @$url$@: URL to the item - this is usually set automatically.
    --
    -- In addition, the posts should be named according to the rules for
    -- 'Hakyll.Web.Template.Context.dateField'
    module Hakyll.Web.Feed
        ( FeedConfiguration (..)
        , renderRss
        , renderAtom
        , renderJson
        , renderRssWithTemplates
        , renderAtomWithTemplates
        , renderJsonWithTemplates
        ) where

    --------------------------------------------------------------------------------
    import           Hakyll.Core.Compiler
    import           Hakyll.Core.Item
    import           Hakyll.Core.Util.String     (replaceAll)
    import           Hakyll.Web.Template
    import           Hakyll.Web.Template.Context
    import           Hakyll.Web.Template.List

    --------------------------------------------------------------------------------
    import           Data.FileEmbed              (makeRelativeToProject)
    import           System.FilePath             ((</>))
    import Text.Printf (printf)

    --------------------------------------------------------------------------------
    rssTemplate :: Template
    rssTemplate :: Template
    rssTemplate =
        $(makeRelativeToProject ("data" </> "templates" </> "rss.xml")
            >>= embedTemplate)

    rssItemTemplate :: Template
    rssItemTemplate :: Template
    rssItemTemplate =
        $(makeRelativeToProject ("data" </> "templates" </> "rss-item.xml")
            >>= embedTemplate)

    atomTemplate :: Template
    atomTemplate :: Template
    atomTemplate =
        $(makeRelativeToProject ("data" </> "templates" </> "atom.xml")
            >>= embedTemplate)

    atomItemTemplate :: Template
    atomItemTemplate :: Template
    atomItemTemplate =
        $(makeRelativeToProject ("data" </> "templates" </> "atom-item.xml")
            >>= embedTemplate)

    jsonTemplate :: Template
    jsonTemplate :: Template
    jsonTemplate =
        $(makeRelativeToProject ("data" </> "templates" </> "feed.json")
            >>= embedTemplate)

    jsonItemTemplate :: Template
    jsonItemTemplate :: Template
    jsonItemTemplate =
        $(makeRelativeToProject ("data" </> "templates" </> "feed-item.json")
            >>= embedTemplate)

    --------------------------------------------------------------------------------
    -- | This is a data structure to keep the configuration of a feed.
    data FeedConfiguration = FeedConfiguration
        { -- | Title of the feed.
          FeedConfiguration -> String
    feedTitle       :: String
        , -- | Description of the feed.
          FeedConfiguration -> String
    feedDescription :: String
        , -- | Name of the feed author.
          FeedConfiguration -> String
    feedAuthorName  :: String
        , -- | Email of the feed author.  Set this to the empty String to leave out
          -- the email address.
          FeedConfiguration -> String
    feedAuthorEmail :: String
        , -- | Absolute root URL of the feed site (e.g. @http://jaspervdj.be@)
          FeedConfiguration -> String
    feedRoot        :: String
        } deriving (Int -> FeedConfiguration -> ShowS
    [FeedConfiguration] -> ShowS
    FeedConfiguration -> String
    (Int -> FeedConfiguration -> ShowS)
    -> (FeedConfiguration -> String)
    -> ([FeedConfiguration] -> ShowS)
    -> Show FeedConfiguration
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FeedConfiguration -> ShowS
    showsPrec :: Int -> FeedConfiguration -> ShowS
    $cshow :: FeedConfiguration -> String
    show :: FeedConfiguration -> String
    $cshowList :: [FeedConfiguration] -> ShowS
    showList :: [FeedConfiguration] -> ShowS
    Show, FeedConfiguration -> FeedConfiguration -> Bool
    (FeedConfiguration -> FeedConfiguration -> Bool)
    -> (FeedConfiguration -> FeedConfiguration -> Bool)
    -> Eq FeedConfiguration
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FeedConfiguration -> FeedConfiguration -> Bool
    == :: FeedConfiguration -> FeedConfiguration -> Bool
    $c/= :: FeedConfiguration -> FeedConfiguration -> Bool
    /= :: FeedConfiguration -> FeedConfiguration -> Bool
    Eq)

    --------------------------------------------------------------------------------
    -- | Different types a feed can have.
    data FeedType = XmlFeed | JsonFeed
      deriving (Int -> FeedType -> ShowS
    [FeedType] -> ShowS
    FeedType -> String
    (Int -> FeedType -> ShowS)
    -> (FeedType -> String) -> ([FeedType] -> ShowS) -> Show FeedType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FeedType -> ShowS
    showsPrec :: Int -> FeedType -> ShowS
    $cshow :: FeedType -> String
    show :: FeedType -> String
    $cshowList :: [FeedType] -> ShowS
    showList :: [FeedType] -> ShowS
    Show, FeedType -> FeedType -> Bool
    (FeedType -> FeedType -> Bool)
    -> (FeedType -> FeedType -> Bool) -> Eq FeedType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FeedType -> FeedType -> Bool
    == :: FeedType -> FeedType -> Bool
    $c/= :: FeedType -> FeedType -> Bool
    /= :: FeedType -> FeedType -> Bool
    Eq)

    --------------------------------------------------------------------------------
    -- | Abstract function to render any feed.
    renderFeed :: FeedType                -- ^ Feed type
               -> Template                -- ^ Default feed template
               -> Template                -- ^ Default item template
               -> FeedConfiguration       -- ^ Feed configuration
               -> Context String          -- ^ Context for the items
               -> [Item String]           -- ^ Input items
               -> Compiler (Item String)  -- ^ Resulting item
    renderFeed :: FeedType
    -> Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderFeed FeedType
    feedType Template
    feedTpl Template
    itemTpl FeedConfiguration
    config Context String
    itemContext [Item String]
    items = do
        [Item String]
    protectedItems <-
          case FeedType
    feedType of
            FeedType
    XmlFeed  -> (Item String -> Compiler (Item String))
    -> [Item String] -> Compiler [Item String]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (ShowS -> Item String -> Compiler (Item String)
    forall (m :: * -> *) (f :: * -> *).
    (Monad m, Functor f) =>
    ShowS -> f String -> m (f String)
    applyFilter ShowS
    protectCDATA) [Item String]
    items
            FeedType
    JsonFeed -> [Item String] -> Compiler [Item String]
    forall a. a -> Compiler a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Item String]
    items
        let itemDelim :: String
    itemDelim = case FeedType
    feedType of
              FeedType
    XmlFeed  -> String
    ""
              FeedType
    JsonFeed -> String
    ", "

        Item String
    body <- String -> Compiler (Item String)
    forall a. a -> Compiler (Item a)
    makeItem (String -> Compiler (Item String))
    -> Compiler String -> Compiler (Item String)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String
    -> Template -> Context String -> [Item String] -> Compiler String
    forall a.
    String -> Template -> Context a -> [Item a] -> Compiler String
    applyJoinTemplateList String
    itemDelim Template
    itemTpl Context String
    itemContext' [Item String]
    protectedItems
        Template -> Context String -> Item String -> Compiler (Item String)
    forall a. Template -> Context a -> Item a -> Compiler (Item String)
    applyTemplate Template
    feedTpl Context String
    feedContext Item String
    body
      where
        applyFilter :: (Monad m,Functor f) => (String -> String) -> f String -> m (f String)
        applyFilter :: forall (m :: * -> *) (f :: * -> *).
    (Monad m, Functor f) =>
    ShowS -> f String -> m (f String)
    applyFilter ShowS
    tr f String
    str = f String -> m (f String)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (f String -> m (f String)) -> f String -> m (f String)
    forall a b. (a -> b) -> a -> b
    $ ShowS -> f String -> f String
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ShowS
    tr f String
    str
        protectCDATA :: String -> String
        protectCDATA :: ShowS
    protectCDATA = String -> ShowS -> ShowS
    replaceAll String
    "]]>" (String -> ShowS
    forall a b. a -> b -> a
    const String
    "]]&gt;")

        itemContext' :: Context String
    itemContext' = [Context String] -> Context String
    forall a. Monoid a => [a] -> a
    mconcat
            [ Context String -> Context String
    forall {a}. Context a -> Context a
    escapeDescription Context String
    itemContext
            , String -> String -> Context String
    forall a. String -> String -> Context a
    constField String
    "root" (FeedConfiguration -> String
    feedRoot FeedConfiguration
    config)
            , String -> String -> Context String
    forall a. String -> String -> Context a
    constField String
    "authorName"  (FeedConfiguration -> String
    feedAuthorName FeedConfiguration
    config)
            , Context String
    forall {a}. Context a
    emailField
            ]

        feedContext :: Context String
    feedContext = [Context String] -> Context String
    forall a. Monoid a => [a] -> a
    mconcat
             [ String -> Context String
    bodyField  String
    "body"
             , String -> String -> Context String
    forall a. String -> String -> Context a
    constField String
    "title"       (FeedConfiguration -> String
    feedTitle FeedConfiguration
    config)
             , String -> String -> Context String
    forall a. String -> String -> Context a
    constField String
    "description" (FeedConfiguration -> String
    feedDescription FeedConfiguration
    config)
             , String -> String -> Context String
    forall a. String -> String -> Context a
    constField String
    "authorName"  (FeedConfiguration -> String
    feedAuthorName FeedConfiguration
    config)
             , Context String
    forall {a}. Context a
    emailField
             , String -> String -> Context String
    forall a. String -> String -> Context a
    constField String
    "root"        (FeedConfiguration -> String
    feedRoot FeedConfiguration
    config)
             , String -> Context String
    forall a. String -> Context a
    urlField   String
    "url"
             , Context String
    forall {a}. Context a
    updatedField
             , Context String
    forall {a}. Context a
    missingField
             ]

        -- Take the first "updated" field from all items -- this should be the most
        -- recent.
        updatedField :: Context a
    updatedField = String -> (Item a -> Compiler String) -> Context a
    forall a. String -> (Item a -> Compiler String) -> Context a
    field String
    "updated" ((Item a -> Compiler String) -> Context a)
    -> (Item a -> Compiler String) -> Context a
    forall a b. (a -> b) -> a -> b
    $ \Item a
    _ -> case [Item String]
    items of
            []      -> String -> Compiler String
    forall a. a -> Compiler a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "Unknown"
            (Item String
    x : [Item String]
    _) -> Context String
    -> String -> [String] -> Item String -> Compiler ContextField
    forall a.
    Context a -> String -> [String] -> Item a -> Compiler ContextField
    unContext Context String
    itemContext' String
    "updated" [] Item String
    x Compiler ContextField
    -> (ContextField -> Compiler String) -> Compiler String
    forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ContextField
    cf -> case ContextField
    cf of
                StringField String
    s -> String -> Compiler String
    forall a. a -> Compiler a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s
                ContextField
    _             -> String -> Compiler String
    forall a. String -> Compiler a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Hakyll.Web.Feed.renderFeed: Internal error"

        emailField :: Context a
    emailField = case FeedConfiguration -> String
    feedAuthorEmail FeedConfiguration
    config of
            String
    ""    -> Context a
    forall {a}. Context a
    missingField
            String
    email -> String -> String -> Context a
    forall a. String -> String -> Context a
    constField String
    "authorEmail" String
    email

        escapeDescription :: Context a -> Context a
    escapeDescription = case FeedType
    feedType of
            FeedType
    XmlFeed  -> Context a -> Context a
    forall a. a -> a
    id
            FeedType
    JsonFeed -> (String -> Bool) -> ShowS -> Context a -> Context a
    forall a. (String -> Bool) -> ShowS -> Context a -> Context a
    mapContextBy (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "description") ShowS
    escapeString

    --------------------------------------------------------------------------------
    -- | Render an RSS feed using given templates with a number of items.
    renderRssWithTemplates ::
           Template                -- ^ Feed template
        -> Template                -- ^ Item template
        -> FeedConfiguration       -- ^ Feed configuration
        -> Context String          -- ^ Item context
        -> [Item String]           -- ^ Feed items
        -> Compiler (Item String)  -- ^ Resulting feed
    renderRssWithTemplates :: Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderRssWithTemplates Template
    feedTemplate Template
    itemTemplate FeedConfiguration
    config Context String
    context = FeedType
    -> Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderFeed
        FeedType
    XmlFeed Template
    feedTemplate Template
    itemTemplate FeedConfiguration
    config
        (String -> Context String -> Context String
    forall a. String -> Context a -> Context a
    makeItemContext String
    "%a, %d %b %Y %H:%M:%S UT" Context String
    context)

    --------------------------------------------------------------------------------
    -- | Render an Atom feed using given templates with a number of items.
    renderAtomWithTemplates ::
           Template                -- ^ Feed template
        -> Template                -- ^ Item template
        -> FeedConfiguration       -- ^ Feed configuration
        -> Context String          -- ^ Item context
        -> [Item String]           -- ^ Feed items
        -> Compiler (Item String)  -- ^ Resulting feed
    renderAtomWithTemplates :: Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderAtomWithTemplates Template
    feedTemplate Template
    itemTemplate FeedConfiguration
    config Context String
    context = FeedType
    -> Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderFeed
        FeedType
    XmlFeed Template
    feedTemplate Template
    itemTemplate FeedConfiguration
    config
        (String -> Context String -> Context String
    forall a. String -> Context a -> Context a
    makeItemContext String
    "%Y-%m-%dT%H:%M:%SZ" Context String
    context)

    --------------------------------------------------------------------------------
    -- | Render a JSON feed using given templates with a number of items.
    renderJsonWithTemplates ::
           Template                -- ^ Feed template
        -> Template                -- ^ Item template
        -> FeedConfiguration       -- ^ Feed configuration
        -> Context String          -- ^ Item context
        -> [Item String]           -- ^ Feed items
        -> Compiler (Item String)  -- ^ Resulting feed
    renderJsonWithTemplates :: Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderJsonWithTemplates Template
    feedTemplate Template
    itemTemplate FeedConfiguration
    config Context String
    context = FeedType
    -> Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderFeed
        FeedType
    JsonFeed Template
    feedTemplate Template
    itemTemplate FeedConfiguration
    config
        (String -> Context String -> Context String
    forall a. String -> Context a -> Context a
    makeItemContext String
    "%Y-%m-%dT%H:%M:%SZ" Context String
    context)

    --------------------------------------------------------------------------------
    -- | Render an RSS feed with a number of items.
    renderRss :: FeedConfiguration       -- ^ Feed configuration
              -> Context String          -- ^ Item context
              -> [Item String]           -- ^ Feed items
              -> Compiler (Item String)  -- ^ Resulting feed
    renderRss :: FeedConfiguration
    -> Context String -> [Item String] -> Compiler (Item String)
    renderRss = Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderRssWithTemplates Template
    rssTemplate Template
    rssItemTemplate

    --------------------------------------------------------------------------------
    -- | Render an Atom feed with a number of items.
    renderAtom :: FeedConfiguration       -- ^ Feed configuration
               -> Context String          -- ^ Item context
               -> [Item String]           -- ^ Feed items
               -> Compiler (Item String)  -- ^ Resulting feed
    renderAtom :: FeedConfiguration
    -> Context String -> [Item String] -> Compiler (Item String)
    renderAtom = Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderAtomWithTemplates Template
    atomTemplate Template
    atomItemTemplate

    --------------------------------------------------------------------------------
    -- | Render a JSON feed with a number of items.
    --
    -- Items' bodies will be put into @content_html@ field of the resulting JSON;
    -- the @content@ field will not be set.
    renderJson :: FeedConfiguration       -- ^ Feed configuration
               -> Context String          -- ^ Item context
               -> [Item String]           -- ^ Feed items
               -> Compiler (Item String)  -- ^ Resulting feed
    renderJson :: FeedConfiguration
    -> Context String -> [Item String] -> Compiler (Item String)
    renderJson = Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
    renderJsonWithTemplates Template
    jsonTemplate Template
    jsonItemTemplate

    --------------------------------------------------------------------------------
    -- | Copies @$updated$@ from @$published$@ if it is not already set.
    makeItemContext :: String -> Context a -> Context a
    makeItemContext :: forall a. String -> Context a -> Context a
    makeItemContext String
    fmt Context a
    context = [Context a] -> Context a
    forall a. Monoid a => [a] -> a
    mconcat
        [Context a
    context, String -> String -> Context a
    forall a. String -> String -> Context a
    dateField String
    "published" String
    fmt, String -> String -> Context a
    forall a. String -> String -> Context a
    dateField String
    "updated" String
    fmt]

    --------------------------------------------------------------------------------
    -- | Escape the string according to [RFC8259 §7](https://www.rfc-editor.org/rfc/rfc8259#section-7). In other words,
    --   * quotation marks and backslashes are prefixed with a backslash
    --   * control characters (i.e. 0x00 - 0x1F) are escaped s.t. their
    --   hex representation are prefixed with "\u00" (e.g. 0x15 -> \u0015)
    --   * the rest of the characters are untouched.
    escapeString :: String -> String
    escapeString :: ShowS
    escapeString = (String -> ShowS) -> String -> ShowS
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> ShowS
    escapeString' String
    ""
      where
        escapeString' :: String -> ShowS
        escapeString' :: String -> ShowS
    escapeString' [] String
    s = String
    s
        escapeString' (Char
    '"' : String
    cs) String
    s = String -> ShowS
    showString String
    "\\\"" (String -> ShowS
    escapeString' String
    cs String
    s)
        escapeString' (Char
    '\\' : String
    cs) String
    s = String -> ShowS
    showString String
    "\\\\" (String -> ShowS
    escapeString' String
    cs String
    s)
        escapeString' (Char
    c : String
    cs) String
    s
          | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    < Char
    ' ' = Char -> ShowS
    escapeChar Char
    c (String -> ShowS
    escapeString' String
    cs String
    s)
          | Bool
    otherwise = Char -> ShowS
    showChar Char
    c (String -> ShowS
    escapeString' String
    cs String
    s)

        escapeChar :: Char -> ShowS
        escapeChar :: Char -> ShowS
    escapeChar = String -> ShowS
    showString (String -> ShowS) -> (Char -> String) -> Char -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Char -> String
    forall r. PrintfType r => String -> r
    printf String
    "\\u%04X"