module Rules.Blog.Footer (
    build
) where

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

import           Archives             (MonthlyArchives, YearlyArchives,
                                       archivesMap)
import           Config.Blog          (BlogConfig (..))
import           Config.Program       (tmBlogRoot)
import           Contexts             (siteCtx)
import qualified Contexts.Blog        as BlogCtx
import           Contexts.Field       (tagCloudField', yearMonthArchiveField)
import           Rules.Blog.Type
import           Utils                (mconcatM)

build :: Tags
    -> YearlyArchives
    -> MonthlyArchives
    -> BlogConfReader m Rules ()
build :: forall (m :: * -> *).
Tags
-> YearlyArchives -> MonthlyArchives -> BlogConfReader m Rules ()
build Tags
tags YearlyArchives
y MonthlyArchives
m = do
    Identifier
footerPath <- (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
$ FilePath -> Identifier
fromFilePath (FilePath -> Identifier)
-> (BlogConfig m -> FilePath) -> BlogConfig m -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-footer.html") (FilePath -> FilePath)
-> (BlogConfig m -> FilePath) -> BlogConfig m -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> FilePath
forall (m :: * -> *). BlogConfig m -> FilePath
blogName
    Identifier
recentPostsPath <- (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
$ FilePath -> Identifier
fromFilePath (FilePath -> Identifier)
-> (BlogConfig m -> FilePath) -> BlogConfig m -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-footer-recent-posts-cache") (FilePath -> FilePath)
-> (BlogConfig m -> FilePath) -> BlogConfig m -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> FilePath
forall (m :: * -> *). BlogConfig m -> FilePath
blogName
    Int
pen <- (BlogConfig m -> Int) -> ReaderT (BlogConfig m) Rules Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> Int
forall (m :: * -> *). BlogConfig m -> Int
blogPageEntriesNum
    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
    FilePath
cs <- (BlogConfig m -> FilePath) -> ReaderT (BlogConfig m) Rules FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> FilePath
forall (m :: * -> *). BlogConfig m -> FilePath
blogContentSnapshot
    Context FilePath
pCtxForFooter <- Tags -> BlogConfReader m Rules (Context FilePath)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Tags -> BlogConfReader n m (Context FilePath)
BlogCtx.postCtx Tags
tags
    Context FilePath
footerCtx <- [BlogConfReader m Rules (Context FilePath)]
-> BlogConfReader m Rules (Context FilePath)
forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b
mconcatM [
        Context FilePath -> BlogConfReader m Rules (Context FilePath)
forall a. a -> ReaderT (BlogConfig m) Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context FilePath -> BlogConfReader m Rules (Context FilePath))
-> Context FilePath -> BlogConfReader m Rules (Context FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Tags -> Context FilePath
forall a. FilePath -> Tags -> Context a
tagCloudField' FilePath
"tag-cloud" Tags
tags
      , Context FilePath -> BlogConfReader m Rules (Context FilePath)
forall a. a -> ReaderT (BlogConfig m) Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context FilePath -> BlogConfReader m Rules (Context FilePath))
-> Context FilePath -> BlogConfReader m Rules (Context FilePath)
forall a b. (a -> b) -> a -> b
$ Context FilePath
siteCtx
      , BlogConfReader m Rules (Context FilePath)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context FilePath)
BlogCtx.footerAdditionalComponent
      ]
    let recentPostsCompiler :: Compiler (Item String)
        recentPostsCompiler :: Compiler (Item FilePath)
recentPostsCompiler =
            FilePath -> Compiler (Item FilePath)
forall a. a -> Compiler (Item a)
makeItem (FilePath -> Compiler (Item FilePath))
-> Compiler FilePath -> Compiler (Item FilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Item FilePath] -> FilePath)
-> Compiler [Item FilePath] -> Compiler FilePath
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ([Item FilePath] -> [FilePath]) -> [Item FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item FilePath -> FilePath) -> [Item FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier -> FilePath
toFilePath (Identifier -> FilePath)
-> (Item FilePath -> Identifier) -> Item FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item FilePath -> Identifier
forall a. Item a -> Identifier
itemIdentifier) ([Item FilePath] -> [FilePath])
-> ([Item FilePath] -> [Item FilePath])
-> [Item FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Item FilePath] -> [Item FilePath]
forall a. Int -> [a] -> [a]
take Int
pen) (Compiler [Item FilePath] -> Compiler FilePath)
-> ([Item FilePath] -> Compiler [Item FilePath])
-> [Item FilePath]
-> Compiler FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item FilePath] -> Compiler [Item FilePath]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst
                ([Item FilePath] -> Compiler FilePath)
-> Compiler [Item FilePath] -> Compiler FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Pattern -> FilePath -> Compiler [Item FilePath]
forall a.
(Binary a, Typeable a) =>
Pattern -> FilePath -> Compiler [Item a]
loadAllSnapshots Pattern
ep FilePath
cs :: Compiler [Item String])
    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
$ do
        [Identifier] -> Rules () -> Rules ()
create [Identifier
recentPostsPath] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
            Compiler (Item FilePath) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item FilePath)
recentPostsCompiler
        [Maybe FilePath] -> (Maybe FilePath -> Rules ()) -> Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath -> [Maybe FilePath] -> [Maybe FilePath]
forall a. a -> [a] -> [a]
: ((FilePath, [Identifier]) -> Maybe FilePath)
-> [(FilePath, [Identifier])] -> [Maybe FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> ((FilePath, [Identifier]) -> FilePath)
-> (FilePath, [Identifier])
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, [Identifier]) -> FilePath
forall a b. (a, b) -> a
fst) (YearlyArchives -> [(FilePath, [Identifier])]
forall k. Archives k -> [(k, [Identifier])]
archivesMap YearlyArchives
y)) ((Maybe FilePath -> Rules ()) -> Rules ())
-> (Maybe FilePath -> Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \Maybe FilePath
year -> (Rules () -> Rules ())
-> (FilePath -> Rules () -> Rules ())
-> Maybe FilePath
-> Rules ()
-> Rules ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rules () -> Rules ()
forall a. a -> a
id FilePath -> Rules () -> Rules ()
version Maybe FilePath
year (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
            [Identifier] -> Rules () -> Rules ()
create [Identifier
footerPath] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
                Compiler (Item FilePath) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item FilePath) -> Rules ())
-> Compiler (Item FilePath) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
                    [Identifier]
recentIds <- (FilePath -> Identifier) -> [FilePath] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Identifier
fromFilePath ([FilePath] -> [Identifier])
-> (FilePath -> [FilePath]) -> FilePath -> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [Identifier])
-> Compiler FilePath -> Compiler [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Compiler FilePath
forall a. (Binary a, Typeable a) => Identifier -> Compiler a
loadBody Identifier
recentPostsPath
                    [Item FilePath]
recent <- (Identifier -> Compiler (Item FilePath))
-> [Identifier] -> Compiler [Item FilePath]
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 (Identifier -> FilePath -> Compiler (Item FilePath)
forall a.
(Binary a, Typeable a) =>
Identifier -> FilePath -> Compiler (Item a)
`loadSnapshot` FilePath
cs) [Identifier]
recentIds
                    let ctx :: Context FilePath
ctx = [Context FilePath] -> Context FilePath
forall a. Monoid a => [a] -> a
mconcat [
                            FilePath
-> Context FilePath -> Compiler [Item FilePath] -> Context FilePath
forall a b. FilePath -> Context a -> Compiler [Item a] -> Context b
listField FilePath
"recent-posts" Context FilePath
pCtxForFooter ([Item FilePath] -> Compiler [Item FilePath]
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item FilePath]
recent)
                          , FilePath
-> YearlyArchives
-> MonthlyArchives
-> Maybe FilePath
-> Context FilePath
forall a.
FilePath
-> YearlyArchives -> MonthlyArchives -> Maybe FilePath -> Context a
yearMonthArchiveField FilePath
"archives" YearlyArchives
y MonthlyArchives
m Maybe FilePath
year
                          , Context FilePath
footerCtx
                          ]
                    FilePath -> Compiler (Item FilePath)
forall a. a -> Compiler (Item a)
makeItem FilePath
forall a. Monoid a => a
mempty
                        Compiler (Item FilePath)
-> (Item FilePath -> Compiler (Item FilePath))
-> Compiler (Item FilePath)
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 FilePath -> Item FilePath -> Compiler (Item FilePath)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item FilePath)
loadAndApplyTemplate (FilePath -> Identifier
fromFilePath (FilePath -> Identifier) -> FilePath -> Identifier
forall a b. (a -> b) -> a -> b
$ FilePath
tmBlogRoot FilePath -> FilePath -> FilePath
</> FilePath
"footer.html") Context FilePath
ctx
                        Compiler (Item FilePath)
-> (Item FilePath -> Compiler (Item FilePath))
-> Compiler (Item FilePath)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item FilePath -> Compiler (Item FilePath)
relativizeUrls