{-# LANGUAGE LambdaCase #-}
module Vendor.KaTeX (
    KaTeXRender
  , render
) where

import           Control.Monad.Extra    (concatMapM)
import           Data.Maybe             (fromMaybe)
import           Hakyll
import qualified Text.HTML.TagSoup      as TS
import qualified Text.HTML.TagSoup.Tree as TT

import           Config                 (tagSoupOption)

type KaTeXRender = Item String -> Compiler (Item String)

transformTreeM :: Monad m => (TT.TagTree s -> m [TT.TagTree s]) -> [TT.TagTree s] -> m [TT.TagTree s]
transformTreeM :: forall (m :: * -> *) s.
Monad m =>
(TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s]
transformTreeM TagTree s -> m [TagTree s]
act = (TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s])
-> (TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s]
forall a b. (a -> b) -> a -> b
$ \case
    (TT.TagBranch s
x [Attribute s]
y [TagTree s]
z) -> (TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s]
forall (m :: * -> *) s.
Monad m =>
(TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s]
transformTreeM TagTree s -> m [TagTree s]
act [TagTree s]
z m [TagTree s] -> ([TagTree s] -> m [TagTree s]) -> m [TagTree s]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TagTree s -> m [TagTree s]
act (TagTree s -> m [TagTree s])
-> ([TagTree s] -> TagTree s) -> [TagTree s] -> m [TagTree s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [Attribute s] -> [TagTree s] -> TagTree s
forall str. str -> [Attribute str] -> [TagTree str] -> TagTree str
TT.TagBranch s
x [Attribute s]
y
    TagTree s
x                    -> TagTree s -> m [TagTree s]
act TagTree s
x

render :: KaTeXRender
render :: KaTeXRender
render = (String -> Compiler String) -> KaTeXRender
forall a b. (a -> Compiler b) -> Item a -> Compiler (Item b)
withItemBody ((String -> Compiler String) -> KaTeXRender)
-> (String -> Compiler String) -> KaTeXRender
forall a b. (a -> b) -> a -> b
$ ([TagTree String] -> String)
-> Compiler [TagTree String] -> Compiler String
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RenderOptions String -> [TagTree String] -> String
forall str.
StringLike str =>
RenderOptions str -> [TagTree str] -> str
TT.renderTreeOptions RenderOptions String
tagSoupOption) (Compiler [TagTree String] -> Compiler String)
-> (String -> Compiler [TagTree String])
-> String
-> Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTree String -> Compiler [TagTree String])
-> [TagTree String] -> Compiler [TagTree String]
forall (m :: * -> *) s.
Monad m =>
(TagTree s -> m [TagTree s]) -> [TagTree s] -> m [TagTree s]
transformTreeM TagTree String -> Compiler [TagTree String]
f ([TagTree String] -> Compiler [TagTree String])
-> (String -> [TagTree String])
-> String
-> Compiler [TagTree String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [TagTree String]
forall str. StringLike str => str -> [TagTree str]
TT.parseTree
    where
        f :: TagTree String -> Compiler [TagTree String]
f tag :: TagTree String
tag@(TT.TagBranch String
_ [Attribute String]
as [TT.TagLeaf (TS.TagText String
e)])
            | [Attribute String] -> Bool
hasMathClass [Attribute String]
as = String -> [TagTree String]
forall str. StringLike str => str -> [TagTree str]
TT.parseTree (String -> [TagTree String])
-> Compiler String -> Compiler [TagTree String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                String -> [String] -> String -> Compiler String
unixFilter String
"tools/katex_runner.sh" [String
"displayMode" | [Attribute String] -> Bool
hasDisplayClass [Attribute String]
as] String
e
            | Bool
otherwise = [TagTree String] -> Compiler [TagTree String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [TagTree String
tag]
        f TagTree String
tag = [TagTree String] -> Compiler [TagTree String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [TagTree String
tag]

        hasDisplayClass :: [Attribute String] -> Bool
hasDisplayClass = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"display" ([String] -> Bool)
-> ([Attribute String] -> [String]) -> [Attribute String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute String] -> [String]
classes
        hasMathClass :: [Attribute String] -> Bool
hasMathClass = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"math" ([String] -> Bool)
-> ([Attribute String] -> [String]) -> [Attribute String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute String] -> [String]
classes
        classes :: [Attribute String] -> [String]
classes = String -> [String]
words (String -> [String])
-> ([Attribute String] -> String) -> [Attribute String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ([Attribute String] -> Maybe String)
-> [Attribute String]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Attribute String] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"class"