-- | Pandoc compilation and the post-processing shared by every page
module MathiasSM.Compile (runPandoc, applyTemplates, finish) where

import Control.Monad (foldM)
import Hakyll (
    Compiler,
    Context,
    Identifier,
    Item (itemBody),
    defaultHakyllReaderOptions,
    defaultHakyllWriterOptions,
    getMetadata,
    getUnderlying,
    loadAndApplyTemplate,
    readPandocWith,
    relativizeUrls,
    writePandocWith,
 )
import MathiasSM.Accessibility (checkAccessibility)
import MathiasSM.CleanURL (cleanIndexHtmls, cleanIndexUrls)
import MathiasSM.Config (SiteConfig, siteTemplate)
import MathiasSM.Filters (processRubyText)
import MathiasSM.Html (readonlyCheckboxes)
import MathiasSM.Metadata (Key (TOC), lookupKey)
import Text.Pandoc (Pandoc (Pandoc), nullMeta)
import Text.Pandoc.Options (MathMethod (MathJax), writerMathMethod)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Writers.Shared (toTableOfContents)

-- TODO(citeproc): Citations are left unprocessed today -- `Ext_citations` is on
-- via `pandocExtensions`, but no citeproc/bibliography is configured, so `@key`
-- in prose renders as a bare `<span class="citation">`. If a bibliography (or
-- citeproc) is ever added, literal `@` in content must be escaped as `\@`, or
-- those fragments will silently turn into citations.

-- | Custom configuration for Pandoc
runPandoc :: Item String -> Compiler (Item String)
runPandoc :: Item String -> Compiler (Item String)
runPandoc Item String
item = do
    metadata <- Compiler Identifier
getUnderlying Compiler Identifier
-> (Identifier -> Compiler Metadata) -> Compiler Metadata
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata
    let toc = Key -> Metadata -> Maybe String
lookupKey Key
TOC Metadata
metadata Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"true"
    pandocItem <- readPandocWith defaultHakyllReaderOptions item
    let pandoc' = (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
processRubyText (Item Pandoc -> Pandoc
forall a. Item a -> a
itemBody Item Pandoc
pandocItem)
        body = Item Pandoc -> Pandoc -> String
forall {a}. Item a -> Pandoc -> String
renderPandoc Item Pandoc
pandocItem Pandoc
pandoc'
        tocHtml = if Bool
toc then String
"<nav id=\"TOC\">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Item Pandoc -> Pandoc -> String
forall {a}. Item a -> Pandoc -> String
renderPandoc Item Pandoc
pandocItem (Pandoc -> Pandoc
tocPandoc Pandoc
pandoc') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</nav>" else String
""
    pure (item{itemBody = tocHtml ++ body})
  where
    renderPandoc :: Item a -> Pandoc -> String
renderPandoc Item a
ident Pandoc
pandoc = Item String -> String
forall a. Item a -> a
itemBody (WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
writerOptions (Item a
ident{itemBody = pandoc}))

    tocPandoc :: Pandoc -> Pandoc
tocPandoc Pandoc
pandoc = Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
writerOptions (Pandoc -> [Block]
blocksOf Pandoc
pandoc)]

    blocksOf :: Pandoc -> [Block]
blocksOf (Pandoc Meta
_ [Block]
blocks) = [Block]
blocks

    writerOptions :: WriterOptions
writerOptions =
        WriterOptions
defaultHakyllWriterOptions
            { writerMathMethod = MathJax ""
            }

-- | Applies the given templates in order, each wrapping the previous result
applyTemplates :: Context String -> [Identifier] -> Item String -> Compiler (Item String)
applyTemplates :: Context String
-> [Identifier] -> Item String -> Compiler (Item String)
applyTemplates Context String
ctx [Identifier]
templates Item String
item = (Item String -> Identifier -> Compiler (Item String))
-> Item String -> [Identifier] -> Compiler (Item String)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Item String
i Identifier
t -> Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
t Context String
ctx Item String
i) Item String
item [Identifier]
templates

-- | Factors out the final common default steps for basically all pages
finish :: SiteConfig -> Context String -> Item String -> Compiler (Item String)
finish :: SiteConfig
-> Context String -> Item String -> Compiler (Item String)
finish SiteConfig
cfg Context String
context Item String
item =
    Context String
-> [Identifier] -> Item String -> Compiler (Item String)
applyTemplates Context String
context [SiteConfig -> Identifier
siteTemplate SiteConfig
cfg] Item String
item
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> 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
>>= Item String -> Compiler (Item String)
relativizeUrls
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> 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
>>= Item String -> Compiler (Item String)
cleanIndexUrls
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> 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
>>= Item String -> Compiler (Item String)
cleanIndexHtmls
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> 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
>>= Item String -> Compiler (Item String)
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Item String -> Compiler (Item String))
-> (Item String -> Item String)
-> Item String
-> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Item String -> Item String
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
readonlyCheckboxes
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> 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
>>= Item String -> Compiler (Item String)
checkAccessibility