{-# LANGUAGE LambdaCase, OverloadedStrings, TemplateHaskell #-}
module Hakyll.Web.Feed.Extra (
    FeedConfiguration (..)
  , renderRss
  , renderAtom
) where

import           Data.FileEmbed              (makeRelativeToProject)
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           System.FilePath             ((</>))

data FeedConfiguration = FeedConfiguration {
    FeedConfiguration -> String
feedTitle       :: String
  , FeedConfiguration -> String
feedWebRoot     :: String
  , FeedConfiguration -> String
feedBlogName    :: String
  , FeedConfiguration -> String
feedDescription :: String
  , FeedConfiguration -> String
feedAuthorName  :: String
  , FeedConfiguration -> String
feedAuthorEmail :: 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)

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

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

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

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

renderFeed :: Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
renderFeed :: Template
-> Template
-> FeedConfiguration
-> Context String
-> [Item String]
-> Compiler (Item String)
renderFeed Template
feedTpl Template
itemTpl FeedConfiguration
config Context String
itemContext [Item String]
items = do
    [Item String]
protectedItems <- (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
    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
=<< Template -> Context String -> [Item String] -> Compiler String
forall a. Template -> Context a -> [Item a] -> Compiler String
applyTemplateList 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
itemContext
            , String -> String -> Context String
forall a. String -> String -> Context a
constField String
"webroot" (FeedConfiguration -> String
feedWebRoot FeedConfiguration
config)
            , String -> String -> Context String
forall a. String -> String -> Context a
constField String
"authorName"  (FeedConfiguration -> String
feedAuthorName FeedConfiguration
config)
            , String -> String -> Context String
forall a. String -> String -> Context a
constField String
"authorEmail" (FeedConfiguration -> String
feedAuthorEmail FeedConfiguration
config)
            ]

        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
"webroot" (FeedConfiguration -> String
feedWebRoot FeedConfiguration
config)
            , String -> String -> Context String
forall a. String -> String -> Context a
constField String
"blog-title" (FeedConfiguration -> String
feedBlogName 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)
            , String -> String -> Context String
forall a. String -> String -> Context a
constField String
"authorEmail" (FeedConfiguration -> String
feedAuthorEmail 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
            ]

        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
$ Compiler String -> Item a -> Compiler String
forall a b. a -> b -> a
const (Compiler String -> Item a -> Compiler String)
-> Compiler String -> Item a -> Compiler String
forall a b. (a -> b) -> a -> b
$ 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
>>= \case
                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.Extra.renderFeed: Internal error"


renderRssWithTemplates :: Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
renderRssWithTemplates :: Template
-> Template
-> FeedConfiguration
-> Context String
-> [Item String]
-> Compiler (Item String)
renderRssWithTemplates Template
feedTemplate Template
itemTemplate FeedConfiguration
config Context String
context = Template
-> Template
-> FeedConfiguration
-> Context String
-> [Item String]
-> Compiler (Item String)
renderFeed
    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)

renderAtomWithTemplates :: Template
    -> Template
    -> FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
renderAtomWithTemplates :: Template
-> Template
-> FeedConfiguration
-> Context String
-> [Item String]
-> Compiler (Item String)
renderAtomWithTemplates Template
feedTemplate Template
itemTemplate FeedConfiguration
config Context String
context = Template
-> Template
-> FeedConfiguration
-> Context String
-> [Item String]
-> Compiler (Item String)
renderFeed
    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)

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]

renderRss :: FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
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

renderAtom :: FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)
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