38 lines
878 B
Haskell
38 lines
878 B
Haskell
|
import Lang
|
||
|
|
import Ebnf
|
||
|
|
import Spans
|
||
|
|
import Glosses
|
||
|
|
|
||
|
|
import Text.Pandoc.Definition
|
||
|
|
import Text.Pandoc.JSON
|
||
|
|
import Text.Pandoc.Walk
|
||
|
|
import qualified Data.Map as Map
|
||
|
|
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = toJSONFilter filter where
|
||
|
|
filter p@(Pandoc (Meta m) _) = do
|
||
|
|
lang' <- toLang $ Map.lookup "lang" m
|
||
|
|
let ?lang = lang'
|
||
|
|
fmap (walk makeEbnf .
|
||
|
|
walk (concatMap makeFigures) .
|
||
|
|
walk inlineLetterList) $
|
||
|
|
walkM spans =<<
|
||
|
|
walkM (fmap concat . traverse glosses) p
|
||
|
|
|
||
|
|
|
||
|
|
makeFigures :: Block -> [Block]
|
||
|
|
makeFigures (Div ("", ["figure"], []) blks) =
|
||
|
|
[html "<figure>"] ++ blks ++ [html "</figure>"]
|
||
|
|
where html = RawBlock (Format "html")
|
||
|
|
makeFigures b = [b]
|
||
|
|
|
||
|
|
|
||
|
|
inlineLetterList :: Block -> Block
|
||
|
|
inlineLetterList (Div a@(_, cs, _) blks)
|
||
|
|
| "letter-list" `elem` cs = Div a (walk go blks)
|
||
|
|
where
|
||
|
|
go (Para xs) = Plain xs
|
||
|
|
go b = b
|
||
|
|
inlineLetterList b = b
|