Rhiannon Morris
99f4d7eac0
the syntax `{.class}` (when interpreted as an implicit
figure) attaches `class` to the `<img>` tag. this moves it to the
`<figure>`
95 lines
2.7 KiB
Haskell
95 lines
2.7 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
import Lang
|
|
import Ebnf
|
|
import Spans
|
|
import Glosses
|
|
|
|
import Text.Pandoc.Definition
|
|
import Text.Pandoc.JSON
|
|
import Text.Pandoc.Walk
|
|
import Data.Maybe
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import System.Environment
|
|
|
|
|
|
main :: IO ()
|
|
main = toJSONFilter filter where
|
|
filter p@(Pandoc (Meta m) _) = do
|
|
lang <- toLang $ Map.lookup "conlang" m
|
|
defColor <- getDefColor m
|
|
let ?lang = lang
|
|
let ?defColor = defColor
|
|
fmap (walk fixFigureClass .
|
|
walk makeEbnf .
|
|
walk makeQuotes .
|
|
walk (concatMap makeBlocks) .
|
|
walk inlineLetterList) $
|
|
walkM spans =<<
|
|
walkM (fmap concat . traverse glosses) p
|
|
|
|
getDefColor :: Map Text MetaValue -> IO Text
|
|
getDefColor m = do
|
|
res <- toText $ Map.lookup "lang-color" m
|
|
case res of
|
|
Just col -> pure col
|
|
Nothing -> do
|
|
env <- lookupEnv "LANG_COLOR"
|
|
pure $ maybe "black" Text.pack env
|
|
|
|
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 (_, c1, a1) cap [Plain [Image (i, c2, a2) alt path]]) =
|
|
Figure (i, c1 ++ c2, a1 ++ a2) cap [Plain [Image ("", [], []) alt path]]
|
|
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 = str == "\"\"\"" || str == "““”" -- lol
|
|
|
|
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
|
|
|
|
|
|
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
|