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 Control.Monad ((>=>)) 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, injectTableOfContents, 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 giscusCtx <- [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.giscus ] 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 (Pandoc -> Compiler Pandoc) -> (Pandoc -> Compiler Pandoc) -> Pandoc -> Compiler Pandoc forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> Pandoc -> Compiler Pandoc forall a. a -> Compiler a forall (m :: * -> *) a. Monad m => a -> m a return (Pandoc -> Compiler Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Compiler Pandoc forall b c a. (b -> c) -> (a -> b) -> a -> c . Pandoc -> Pandoc injectTableOfContents) 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 giscusCtx) 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