module Rules.Blog.Feed.Utils (
    buildFeed
) where

import           Control.Monad.Reader  (asks)
import           Control.Monad.Trans   (MonadTrans (..))
import           Hakyll
import qualified Hakyll.Web.Feed.Extra as FE
import           System.FilePath       (joinPath)

import           Config.Blog           (BlogConfig (..))
import           Rules.Blog.Type

type Render = FE.FeedConfiguration
    -> Context String
    -> [Item String]
    -> Compiler (Item String)

buildFeed :: Snapshot
    -> String
    -> Context String
    -> Render
    -> BlogConfReader n Rules ()
buildFeed :: forall (n :: * -> *).
Snapshot
-> Snapshot
-> Context Snapshot
-> Render
-> BlogConfReader n Rules ()
buildFeed Snapshot
feedSSName Snapshot
suffix Context Snapshot
ctx Render
render = do
    Snapshot
t <- (BlogConfig n -> Snapshot) -> ReaderT (BlogConfig n) Rules Snapshot
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig n -> Snapshot
forall (m :: * -> *). BlogConfig m -> Snapshot
blogName
    [Item Snapshot] -> [Item Snapshot]
feedTake <- (BlogConfig n -> [Item Snapshot] -> [Item Snapshot])
-> ReaderT
     (BlogConfig n) Rules ([Item Snapshot] -> [Item Snapshot])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((BlogConfig n -> [Item Snapshot] -> [Item Snapshot])
 -> ReaderT
      (BlogConfig n) Rules ([Item Snapshot] -> [Item Snapshot]))
-> (BlogConfig n -> [Item Snapshot] -> [Item Snapshot])
-> ReaderT
     (BlogConfig n) Rules ([Item Snapshot] -> [Item Snapshot])
forall a b. (a -> b) -> a -> b
$ Int -> [Item Snapshot] -> [Item Snapshot]
forall a. Int -> [a] -> [a]
take (Int -> [Item Snapshot] -> [Item Snapshot])
-> (BlogConfig n -> Int)
-> BlogConfig n
-> [Item Snapshot]
-> [Item Snapshot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig n -> Int
forall (m :: * -> *). BlogConfig m -> Int
blogFeedRecentNum
    Pattern
ep <- (BlogConfig n -> Pattern) -> ReaderT (BlogConfig n) Rules Pattern
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig n -> Pattern
forall (m :: * -> *). BlogConfig m -> Pattern
blogEntryPattern
    FeedConfiguration
fc <- (BlogConfig n -> FeedConfiguration)
-> ReaderT (BlogConfig n) Rules FeedConfiguration
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig n -> FeedConfiguration
forall (m :: * -> *). BlogConfig m -> FeedConfiguration
blogFeedConfig
    Rules () -> BlogConfReader n Rules ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (BlogConfig n) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules () -> BlogConfReader n Rules ())
-> Rules () -> BlogConfReader n Rules ()
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Rules () -> Rules ()
create [Snapshot -> Identifier
fromFilePath ([Snapshot] -> Snapshot
joinPath [Snapshot
t, Snapshot
"feed", Snapshot
t Snapshot -> Snapshot -> Snapshot
forall a. Semigroup a => a -> a -> a
<> Snapshot
suffix])] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        Routes -> Rules ()
route Routes
idRoute
        Compiler (Item Snapshot) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item Snapshot) -> Rules ())
-> Compiler (Item Snapshot) -> Rules ()
forall a b. (a -> b) -> a -> b
$
            Pattern -> Snapshot -> Compiler [Item Snapshot]
forall a.
(Binary a, Typeable a) =>
Pattern -> Snapshot -> Compiler [Item a]
loadAllSnapshots Pattern
ep Snapshot
feedSSName
                Compiler [Item Snapshot]
-> ([Item Snapshot] -> Compiler [Item Snapshot])
-> Compiler [Item Snapshot]
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Item Snapshot] -> [Item Snapshot])
-> Compiler [Item Snapshot] -> Compiler [Item Snapshot]
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Item Snapshot] -> [Item Snapshot]
feedTake (Compiler [Item Snapshot] -> Compiler [Item Snapshot])
-> ([Item Snapshot] -> Compiler [Item Snapshot])
-> [Item Snapshot]
-> Compiler [Item Snapshot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item Snapshot] -> Compiler [Item Snapshot]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst
                Compiler [Item Snapshot]
-> ([Item Snapshot] -> Compiler (Item Snapshot))
-> Compiler (Item Snapshot)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Render
render FeedConfiguration
fc (Snapshot -> Context Snapshot
bodyField Snapshot
"description" Context Snapshot -> Context Snapshot -> Context Snapshot
forall a. Semigroup a => a -> a -> a
<> Context Snapshot
ctx)