module Rules.Blog.EachPosts (
    build
) where

import           Control.Monad.Reader       (asks)
import           Control.Monad.Trans        (MonadTrans (..))
import           Data.Bool                  (bool)
import           Hakyll
import           System.FilePath            ((</>))

import           Config                     (contentsRoot, readerOptions,
                                             tmBlogRoot)
import           Config.Blog                (BlogConfig (..))
import           Config.Site                (defaultTimeLocale', timeZoneJST)
import qualified Contexts.Blog              as BlogCtx
import           Media.SVG                  (mermaidTransform)
import           Rules.Blog.EachPosts.Utils
import           Rules.Blog.Type
import           Rules.Blog.Utils           (appendFooter)
import           Text.Pandoc.Walk           (walkM)
import           Utils                      (absolutizeUrls, mconcatM,
                                             modifyExternalLinkAttr)
import qualified Vendor.FontAwesome         as FA
import qualified Vendor.KaTeX               as KaTeX

build :: FA.FontAwesomeIcons
    -> Context String
    -> BlogConfReader m Rules Snapshot
build :: forall (m :: * -> *).
FontAwesomeIcons -> Context String -> BlogConfReader m Rules String
build FontAwesomeIcons
faIcons Context String
ctx = do
    Context String
disqusCtx <- [ReaderT (BlogConfig m) Rules (Context String)]
-> ReaderT (BlogConfig m) Rules (Context String)
forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b
mconcatM [
        Context String -> ReaderT (BlogConfig m) Rules (Context String)
forall a. a -> ReaderT (BlogConfig m) Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context String
ctx
      , ReaderT (BlogConfig m) Rules (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
BlogCtx.disqus
      ]
    WriterOptions
wOptions <- (BlogConfig m -> WriterOptions)
-> ReaderT (BlogConfig m) Rules WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> WriterOptions
forall (m :: * -> *). BlogConfig m -> WriterOptions
blogWriterOptions
    String
cs <- (BlogConfig m -> String) -> BlogConfReader m Rules String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> String
forall (m :: * -> *). BlogConfig m -> String
blogContentSnapshot
    String
t <- (BlogConfig m -> String) -> BlogConfReader m Rules String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> String
forall (m :: * -> *). BlogConfig m -> String
blogName
    String
feedContent <- (BlogConfig m -> String) -> BlogConfReader m Rules String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((BlogConfig m -> String) -> BlogConfReader m Rules String)
-> (BlogConfig m -> String) -> BlogConfReader m Rules String
forall a b. (a -> b) -> a -> b
$ (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-feed-content") (String -> String)
-> (BlogConfig m -> String) -> BlogConfig m -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> String
forall (m :: * -> *). BlogConfig m -> String
blogName
    KaTeXRender
katexRender <- (BlogConfig m -> KaTeXRender)
-> ReaderT (BlogConfig m) Rules KaTeXRender
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((BlogConfig m -> KaTeXRender)
 -> ReaderT (BlogConfig m) Rules KaTeXRender)
-> (BlogConfig m -> KaTeXRender)
-> ReaderT (BlogConfig m) Rules KaTeXRender
forall a b. (a -> b) -> a -> b
$ KaTeXRender -> KaTeXRender -> Bool -> KaTeXRender
forall a. a -> a -> Bool -> a
bool KaTeXRender
KaTeX.render KaTeXRender
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> KaTeXRender)
-> (BlogConfig m -> Bool) -> BlogConfig m -> KaTeXRender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> Bool
forall (m :: * -> *). BlogConfig m -> Bool
blogIsPreview

    (Context String -> Rules ()) -> BlogConfReader m Rules ()
forall (m :: * -> *).
(Context String -> Rules ()) -> BlogConfReader m Rules ()
eachPostsSeries ((Context String -> Rules ()) -> BlogConfReader m Rules ())
-> (Context String -> Rules ()) -> BlogConfReader m Rules ()
forall a b. (a -> b) -> a -> b
$ \Context String
s -> do
        Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> String) -> Routes
gsubRoute (String
contentsRoot String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/") (String -> String -> String
forall a b. a -> b -> a
const String
forall a. Monoid a => a
mempty) Routes -> Routes -> Routes
`composeRoutes` String -> Routes
setExtension String
"html"
        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
$ ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Compiler (Item String)
pandocCompilerWithTransformM ReaderOptions
readerOptions WriterOptions
wOptions ((Block -> Compiler Block) -> Pandoc -> Compiler Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> Pandoc -> m Pandoc
walkM Block -> Compiler Block
mermaidTransform)
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
absolutizeUrls
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> KaTeXRender
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
feedContent
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
katexRender
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> KaTeXRender
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
cs
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
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 String -> KaTeXRender
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate (String -> Identifier
fromFilePath (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ String
tmBlogRoot String -> String -> String
</> String
"post.html") (Context String
s Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
disqusCtx)
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> TimeLocale -> TimeZone -> KaTeXRender
forall a.
(Binary a, Typeable a, Semigroup a) =>
String -> TimeLocale -> TimeZone -> Item a -> Compiler (Item a)
appendFooter String
t TimeLocale
defaultTimeLocale' TimeZone
timeZoneJST
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
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 String -> KaTeXRender
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate (String -> Identifier
fromFilePath (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ String
tmBlogRoot String -> String -> String
</> String
"default.html") Context String
ctx
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
modifyExternalLinkAttr
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
relativizeUrls
            Compiler (Item String) -> KaTeXRender -> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FontAwesomeIcons -> KaTeXRender
FA.render FontAwesomeIcons
faIcons

    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
blogEntryFilesPattern
    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
$ Pattern -> Rules () -> Rules ()
match Pattern
ep (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> String) -> Routes
gsubRoute (String
contentsRoot String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/") (String -> String -> String
forall a b. a -> b -> a
const String
forall a. Monoid a => a
mempty)
        Compiler (Item CopyFile) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CopyFile)
copyFileCompiler

    String -> BlogConfReader m Rules String
forall a. a -> ReaderT (BlogConfig m) Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
feedContent