-- | Rules that build the sitemap
module MathiasSM.Rules.Sitemap (processSitemap) where

import Control.Monad (filterM)
import Hakyll (
    Compiler,
    Item,
    Rules,
    compile,
    create,
    getMetadata,
    idRoute,
    itemIdentifier,
    listField,
    loadAll,
    loadAndApplyTemplate,
    makeItem,
    recentFirst,
    route,
 )
import MathiasSM.CleanURL (cleanIndexHtmls)
import MathiasSM.Config (SiteConfig, pagesPattern, postsPattern, resolveTemplate)
import MathiasSM.Content (isSitemapExcluded)
import MathiasSM.Context (globalContext)
import MathiasSM.Writings (discoverGroups)

-- | Builds sitemap.xml from the standalone pages and every post group
processSitemap :: SiteConfig -> Rules ()
processSitemap :: SiteConfig -> Rules ()
processSitemap SiteConfig
cfg = [Identifier] -> Rules () -> Rules ()
create [Identifier
"sitemap.xml"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
idRoute
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        groups <- SiteConfig -> Compiler [String]
forall (m :: * -> *). MonadMetadata m => SiteConfig -> m [String]
discoverGroups SiteConfig
cfg
        posts <- mapM (\String
group -> [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item String] -> Compiler [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> Compiler [Item String]
forall a. (Binary a, Typeable a) => Pattern -> Compiler [Item a]
loadAll (SiteConfig -> String -> Pattern
postsPattern SiteConfig
cfg String
group)) groups
        pages <- loadAll $ pagesPattern cfg "*"
        let allItems = (Item String -> Compiler Bool)
-> [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Item String -> Compiler Bool
isIndexable ([Item String]
pages [Item String] -> [Item String] -> [Item String]
forall a. Semigroup a => a -> a -> a
<> [[Item String]] -> [Item String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Item String]]
posts)
            sitemapCtx = String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"entries" (SiteConfig -> Context String
globalContext SiteConfig
cfg) Compiler [Item String]
allItems Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> SiteConfig -> Context String
globalContext SiteConfig
cfg
        makeItem ""
            >>= loadAndApplyTemplate (resolveTemplate cfg "sitemap.xml") sitemapCtx
            >>= cleanIndexHtmls

-- | Whether an item should appear in the sitemap (not marked `sitemap: false`)
isIndexable :: Item String -> Compiler Bool
isIndexable :: Item String -> Compiler Bool
isIndexable Item String
item = Bool -> Bool
not (Bool -> Bool) -> (Metadata -> Bool) -> Metadata -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Bool
isSitemapExcluded (Metadata -> Bool) -> Compiler Metadata -> Compiler Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata (Item String -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item String
item)