module LangFilter where import Lang import Ebnf import Spans import Glosses import Text.Pandoc.Definition import Text.Pandoc.Walk import Data.Maybe import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import Control.Applicative import Control.Monad langFilter :: Text -> Pandoc -> IO Pandoc langFilter col p@(Pandoc (Meta m) _) = do lang <- toLang $ Map.lookup "conlang" m let ?lang = lang let ?defColor = col let f = map (walk spans . fixFigureClass . makeEbnf . makeQuotes . letterList) . concatMap (makeBlocks <=< glosses) pure $ walk f p pluck :: Eq a => a -> [a] -> Maybe [a] pluck _ [] = Nothing pluck x (y:ys) | x == y = Just ys | otherwise = (x :) <$> pluck x ys pluck1 :: Eq a => [a] -> [a] -> Maybe (a, [a]) pluck1 [] _ = Nothing pluck1 (x:xs) ys = (x,) <$> pluck x ys <|> pluck1 xs ys fixFigureClass :: Block -> Block fixFigureClass (Figure (i1, c1, a1) cap [Plain [Image (i2, c2, a2) alt path]]) = Figure (iF, c1 ++ c2, a1 ++ a2) cap [Plain [Image (iI, [], []) alt path]] where iF = if Text.null i1 then i2 else i1 iI = if Text.null i1 then "" else i2 fixFigureClass b = b makeBlocks :: Block -> [Block] makeBlocks (Div ("", clss, []) blks) | Just (cls, rest) <- pluck1 ["figure", "aside"] clss = let html = RawBlock $ Format "html" open = if null rest then html $ "<" <> cls <> ">" else html $ "<" <> cls <> " class='" <> Text.unwords rest <> "'>" close = html $ " cls <> ">" in [open] ++ blks ++ [close] makeBlocks b = [b] makeQuotes :: Block -> Block makeQuotes para@(Para b) = fromMaybe para $ do inner <- split b return (BlockQuote [Para inner]) where isDelim str = Text.length str == 3 && Text.all isQuote str isQuote c = c == '"' || c == '“' || c == '”' split (Str begin:SoftBreak:rest) = guard (isDelim begin) *> checkEnd rest split _ = empty checkEnd [SoftBreak, Str end] = [] <$ guard (isDelim end) checkEnd (start:rest) = (start :) <$> checkEnd rest checkEnd _ = empty makeQuotes other = other letterList :: Block -> Block letterList (Div a@(_, cs, _) blks) | "letter-list" `elem` cs = Div a (walk go blks) where go (Para xs) = Plain xs go b = b letterList b = b