{-# LANGUAGE OverloadedStrings #-}
module Rules.Blog.Core (
    BlogConfig (..)
  , rules
) where

import           Control.Monad.Reader             (asks)
import           Control.Monad.Trans              (MonadTrans (..))
import           Hakyll                           hiding
                                                  (FeedConfiguration (..),
                                                   renderAtom, renderRss)

import           Config
import qualified Contexts.Blog                    as BlogCtx
import           Rules.Blog.EachPosts             as EachPosts
import qualified Rules.Blog.Feed.Atom             as Atom
import qualified Rules.Blog.Feed.RSS              as RSS
import qualified Rules.Blog.Footer                as Footer
import qualified Rules.Blog.Index                 as Index
import           Rules.Blog.ListPage              (ListPageOpts (..))
import qualified Rules.Blog.Paginate.MonthlyPosts as MonthlyPosts
import qualified Rules.Blog.Paginate.TaggedPosts  as TaggedPosts
import qualified Rules.Blog.Paginate.YearlyPosts  as YearlyPosts
import qualified Rules.Blog.Search                as Search
import           Rules.Blog.Sitemap               as Sitemap
import           Rules.Blog.Type
import           Utils                            (mconcatM)
import qualified Vendor.FontAwesome               as FA

rules :: FA.FontAwesomeIcons -> BlogConfReader Rules Rules ()
rules :: FontAwesomeIcons -> BlogConfReader Rules Rules ()
rules FontAwesomeIcons
faIcons = do
    Tags
tags <- (BlogConfig Rules -> Rules Tags)
-> ReaderT (BlogConfig Rules) Rules (Rules Tags)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig Rules -> Rules Tags
forall (m :: * -> *). BlogConfig m -> m Tags
blogTagBuilder ReaderT (BlogConfig Rules) Rules (Rules Tags)
-> (Rules Tags -> ReaderT (BlogConfig Rules) Rules Tags)
-> ReaderT (BlogConfig Rules) Rules Tags
forall a b.
ReaderT (BlogConfig Rules) Rules a
-> (a -> ReaderT (BlogConfig Rules) Rules b)
-> ReaderT (BlogConfig Rules) Rules b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rules Tags -> ReaderT (BlogConfig Rules) Rules Tags
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (BlogConfig Rules) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
    Context String
postCtx' <- [ReaderT (BlogConfig Rules) Rules (Context String)]
-> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b
mconcatM [
        Tags -> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Tags -> BlogConfReader n m (Context String)
BlogCtx.postCtx Tags
tags
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) a. Monad m => BlogConfReader m m (Context a)
BlogCtx.tagCloud
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.title
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.font
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.headerAdditionalComponent
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.beforeContentBodyAdditionalComponent
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.description
      , ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.gSuite
      ]

    -- each posts
    String
feedContent <- FontAwesomeIcons
-> Context String -> BlogConfReader Rules Rules String
forall (m :: * -> *).
FontAwesomeIcons -> Context String -> BlogConfReader m Rules String
EachPosts.build FontAwesomeIcons
faIcons Context String
postCtx'

    ListPageOpts
listPageOpts <- Context String
-> String
-> Context String
-> Context String
-> Context String
-> Context String
-> String
-> Context String
-> Context String
-> Context String
-> ListPageOpts
ListPageOpts
        (Context String
 -> String
 -> Context String
 -> Context String
 -> Context String
 -> Context String
 -> String
 -> Context String
 -> Context String
 -> Context String
 -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules)
     Rules
     (String
      -> Context String
      -> Context String
      -> Context String
      -> Context String
      -> String
      -> Context String
      -> Context String
      -> Context String
      -> ListPageOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.title
        ReaderT
  (BlogConfig Rules)
  Rules
  (String
   -> Context String
   -> Context String
   -> Context String
   -> Context String
   -> String
   -> Context String
   -> Context String
   -> Context String
   -> ListPageOpts)
-> BlogConfReader Rules Rules String
-> ReaderT
     (BlogConfig Rules)
     Rules
     (Context String
      -> Context String
      -> Context String
      -> Context String
      -> String
      -> Context String
      -> Context String
      -> Context String
      -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BlogConfig Rules -> String) -> BlogConfReader Rules Rules String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig Rules -> String
forall (m :: * -> *). BlogConfig m -> String
blogName
        ReaderT
  (BlogConfig Rules)
  Rules
  (Context String
   -> Context String
   -> Context String
   -> Context String
   -> String
   -> Context String
   -> Context String
   -> Context String
   -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules)
     Rules
     (Context String
      -> Context String
      -> Context String
      -> String
      -> Context String
      -> Context String
      -> Context String
      -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.font
        ReaderT
  (BlogConfig Rules)
  Rules
  (Context String
   -> Context String
   -> Context String
   -> String
   -> Context String
   -> Context String
   -> Context String
   -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules)
     Rules
     (Context String
      -> Context String
      -> String
      -> Context String
      -> Context String
      -> Context String
      -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.description
        ReaderT
  (BlogConfig Rules)
  Rules
  (Context String
   -> Context String
   -> String
   -> Context String
   -> Context String
   -> Context String
   -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules)
     Rules
     (Context String
      -> String
      -> Context String
      -> Context String
      -> Context String
      -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.beforeContentBodyAdditionalComponent
        ReaderT
  (BlogConfig Rules)
  Rules
  (Context String
   -> String
   -> Context String
   -> Context String
   -> Context String
   -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules)
     Rules
     (String
      -> Context String
      -> Context String
      -> Context String
      -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.headerAdditionalComponent
        ReaderT
  (BlogConfig Rules)
  Rules
  (String
   -> Context String
   -> Context String
   -> Context String
   -> ListPageOpts)
-> BlogConfReader Rules Rules String
-> ReaderT
     (BlogConfig Rules)
     Rules
     (Context String
      -> Context String -> Context String -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BlogConfig Rules -> String) -> BlogConfReader Rules Rules String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig Rules -> String
forall (m :: * -> *). BlogConfig m -> String
blogContentSnapshot
        ReaderT
  (BlogConfig Rules)
  Rules
  (Context String
   -> Context String -> Context String -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules)
     Rules
     (Context String -> Context String -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.gSuite
        ReaderT
  (BlogConfig Rules)
  Rules
  (Context String -> Context String -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT
     (BlogConfig Rules) Rules (Context String -> ListPageOpts)
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.listCtx
        ReaderT (BlogConfig Rules) Rules (Context String -> ListPageOpts)
-> ReaderT (BlogConfig Rules) Rules (Context String)
-> ReaderT (BlogConfig Rules) Rules ListPageOpts
forall a b.
ReaderT (BlogConfig Rules) Rules (a -> b)
-> ReaderT (BlogConfig Rules) Rules a
-> ReaderT (BlogConfig Rules) Rules b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tags -> ReaderT (BlogConfig Rules) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Tags -> BlogConfReader n m (Context String)
BlogCtx.postCtx Tags
tags

    -- tagged paginate
    FontAwesomeIcons
-> Tags -> ListPageOpts -> BlogConfReader Rules Rules ()
forall (n :: * -> *).
FontAwesomeIcons
-> Tags -> ListPageOpts -> BlogConfReader n Rules ()
TaggedPosts.build FontAwesomeIcons
faIcons Tags
tags ListPageOpts
listPageOpts

    -- yearly paginate
    YearlyArchives
yearlyArchives <- FontAwesomeIcons
-> Tags
-> ListPageOpts
-> BlogConfReader Rules Rules YearlyArchives
YearlyPosts.build FontAwesomeIcons
faIcons Tags
tags ListPageOpts
listPageOpts

    -- monthly paginate
    MonthlyArchives
monthlyArchives <- FontAwesomeIcons
-> Tags
-> ListPageOpts
-> BlogConfReader Rules Rules MonthlyArchives
MonthlyPosts.build FontAwesomeIcons
faIcons Tags
tags ListPageOpts
listPageOpts

    -- the index page of blog
    FontAwesomeIcons
-> Tags -> ListPageOpts -> BlogConfReader Rules Rules ()
forall (n :: * -> *).
FontAwesomeIcons
-> Tags -> ListPageOpts -> BlogConfReader n Rules ()
Index.build FontAwesomeIcons
faIcons Tags
tags ListPageOpts
listPageOpts

    -- footer
    Tags
-> YearlyArchives
-> MonthlyArchives
-> BlogConfReader Rules Rules ()
forall (m :: * -> *).
Tags
-> YearlyArchives -> MonthlyArchives -> BlogConfReader m Rules ()
Footer.build Tags
tags YearlyArchives
yearlyArchives MonthlyArchives
monthlyArchives

    -- Atom and RSS Feed
    ((String -> Context String -> BlogConfReader Rules Rules ())
 -> BlogConfReader Rules Rules ())
-> [String -> Context String -> BlogConfReader Rules Rules ()]
-> BlogConfReader Rules Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((Context String -> BlogConfReader Rules Rules ())
 -> Context String -> BlogConfReader Rules Rules ())
-> Context String
-> (Context String -> BlogConfReader Rules Rules ())
-> BlogConfReader Rules Rules ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Context String -> BlogConfReader Rules Rules ())
-> Context String -> BlogConfReader Rules Rules ()
forall a. a -> a
id Context String
postCtx' ((Context String -> BlogConfReader Rules Rules ())
 -> BlogConfReader Rules Rules ())
-> ((String -> Context String -> BlogConfReader Rules Rules ())
    -> Context String -> BlogConfReader Rules Rules ())
-> (String -> Context String -> BlogConfReader Rules Rules ())
-> BlogConfReader Rules Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> Context String -> BlogConfReader Rules Rules ())
 -> String -> Context String -> BlogConfReader Rules Rules ())
-> String
-> (String -> Context String -> BlogConfReader Rules Rules ())
-> Context String
-> BlogConfReader Rules Rules ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Context String -> BlogConfReader Rules Rules ())
-> String -> Context String -> BlogConfReader Rules Rules ()
forall a. a -> a
id String
feedContent) [String -> Context String -> BlogConfReader Rules Rules ()
forall (n :: * -> *).
String -> Context String -> BlogConfReader n Rules ()
Atom.build, String -> Context String -> BlogConfReader Rules Rules ()
forall (n :: * -> *).
String -> Context String -> BlogConfReader n Rules ()
RSS.build]

    -- Search result page
    FontAwesomeIcons -> Context String -> BlogConfReader Rules Rules ()
forall (m :: * -> *).
FontAwesomeIcons -> Context String -> BlogConfReader m Rules ()
Search.build FontAwesomeIcons
faIcons Context String
postCtx'

    -- Site map
    String -> BlogConfReader Rules Rules ()
forall (m :: * -> *). String -> BlogConfReader m Rules ()
Sitemap.build String
feedContent