module Rules.Blog.Sitemap (
    build
) where

import           Control.Monad.Reader (asks, lift)
import           Hakyll
import           System.FilePath      ((</>))

import           Config               (tmBlogRoot)
import           Config.Blog          (BlogConfig (..))
import           Config.Site          (siteName)
import           Contexts             (siteMapDateCtx)
import qualified Contexts.Blog        as BlogCtx
import           Rules.Blog.Type
import           Utils                (mconcatM)

build :: Snapshot
    -> BlogConfReader m Rules ()
build :: forall (m :: * -> *). Snapshot -> BlogConfReader m Rules ()
build Snapshot
feedSS = do
    Identifier
sitemapXML <- (BlogConfig m -> Identifier)
-> ReaderT (BlogConfig m) Rules Identifier
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((BlogConfig m -> Identifier)
 -> ReaderT (BlogConfig m) Rules Identifier)
-> (BlogConfig m -> Identifier)
-> ReaderT (BlogConfig m) Rules Identifier
forall a b. (a -> b) -> a -> b
$ Snapshot -> Identifier
fromFilePath (Snapshot -> Identifier)
-> (BlogConfig m -> Snapshot) -> BlogConfig m -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Snapshot -> Snapshot -> Snapshot
</> Snapshot
xml) (Snapshot -> Snapshot)
-> (BlogConfig m -> Snapshot) -> BlogConfig m -> Snapshot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> Snapshot
forall (m :: * -> *). BlogConfig m -> Snapshot
blogName
    Pattern
ep <- (BlogConfig m -> Pattern) -> ReaderT (BlogConfig m) Rules Pattern
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> Pattern
forall (m :: * -> *). BlogConfig m -> Pattern
blogEntryPattern
    Context Snapshot
ctx <- [ReaderT (BlogConfig m) Rules (Context Snapshot)]
-> ReaderT (BlogConfig m) Rules (Context Snapshot)
forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b
mconcatM [
        ReaderT (BlogConfig m) Rules (Context Snapshot)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context Snapshot)
BlogCtx.title
      , Context Snapshot -> ReaderT (BlogConfig m) Rules (Context Snapshot)
forall a. a -> ReaderT (BlogConfig m) Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context Snapshot
forall {a}. Context a
hostCtx
      ]
    Rules () -> BlogConfReader m Rules ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (BlogConfig m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules () -> BlogConfReader m Rules ())
-> Rules () -> BlogConfReader m Rules ()
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Rules () -> Rules ()
create [Identifier
sitemapXML] (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
$ do
            [Item Snapshot]
posts <- [Item Snapshot] -> Compiler [Item Snapshot]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item Snapshot] -> Compiler [Item Snapshot])
-> Compiler [Item Snapshot] -> Compiler [Item Snapshot]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> Snapshot -> Compiler [Item Snapshot]
forall a.
(Binary a, Typeable a) =>
Pattern -> Snapshot -> Compiler [Item a]
loadAllSnapshots Pattern
ep Snapshot
feedSS
            let sitemapCtx :: Context Snapshot
sitemapCtx = [Context Snapshot] -> Context Snapshot
forall a. Monoid a => [a] -> a
mconcat [
                    Context Snapshot
ctx
                  , Snapshot
-> Context Snapshot -> Compiler [Item Snapshot] -> Context Snapshot
forall a b. Snapshot -> Context a -> Compiler [Item a] -> Context b
listField Snapshot
"pages" ([Context Snapshot] -> Context Snapshot
forall a. Monoid a => [a] -> a
mconcat [Context Snapshot
siteMapDateCtx, Context Snapshot
forall {a}. Context a
hostCtx, Context Snapshot
defaultContext]) ([Item Snapshot] -> Compiler [Item Snapshot]
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item Snapshot]
posts)
                  ]
            Snapshot -> Compiler (Item Snapshot)
forall a. a -> Compiler (Item a)
makeItem Snapshot
forall a. Monoid a => a
mempty
                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
>>= Identifier
-> Context Snapshot -> Item Snapshot -> Compiler (Item Snapshot)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item Snapshot)
loadAndApplyTemplate (Snapshot -> Identifier
fromFilePath (Snapshot -> Identifier) -> Snapshot -> Identifier
forall a b. (a -> b) -> a -> b
$ Snapshot
tmBlogRoot Snapshot -> Snapshot -> Snapshot
</> Snapshot
xml) Context Snapshot
sitemapCtx
    where
        hostCtx :: Context a
hostCtx = Snapshot -> Snapshot -> Context a
forall a. Snapshot -> Snapshot -> Context a
constField Snapshot
"webroot" (Snapshot
"https://" Snapshot -> Snapshot -> Snapshot
forall a. Semigroup a => a -> a -> a
<> Snapshot
siteName)
        xml :: Snapshot
xml = Snapshot
"sitemap.xml"