add alt blockquote syntax to langfilter

"""
like this
"""
This commit is contained in:
Rhiannon Morris 2023-10-06 02:02:25 +02:00
parent f6d10672d2
commit 9d23f99948

View file

@ -8,9 +8,11 @@ import Glosses
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.JSON import Text.Pandoc.JSON
import Text.Pandoc.Walk import Text.Pandoc.Walk
import Data.Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.Applicative
import qualified Data.Text as Text import qualified Data.Text as Text
import Control.Applicative
import Control.Monad
main :: IO () main :: IO ()
@ -19,6 +21,7 @@ main = toJSONFilter filter where
lang' <- toLang $ Map.lookup "conlang" m lang' <- toLang $ Map.lookup "conlang" m
let ?lang = lang' let ?lang = lang'
fmap (walk makeEbnf . fmap (walk makeEbnf .
walk makeQuotes .
walk (concatMap makeBlocks) . walk (concatMap makeBlocks) .
walk inlineLetterList) $ walk inlineLetterList) $
walkM spans =<< walkM spans =<<
@ -39,12 +42,30 @@ makeBlocks :: Block -> [Block]
makeBlocks (Div ("", clss, []) blks) makeBlocks (Div ("", clss, []) blks)
| Just (cls, rest) <- pluck1 ["figure", "aside"] clss = | Just (cls, rest) <- pluck1 ["figure", "aside"] clss =
let html = RawBlock $ Format "html" let html = RawBlock $ Format "html"
open = html $ "<" <> cls <> " class='" <> Text.unwords rest <> "'>" open = if null rest then
html $ "<" <> cls <> ">"
else
html $ "<" <> cls <> " class='" <> Text.unwords rest <> "'>"
close = html $ "</" <> cls <> ">" close = html $ "</" <> cls <> ">"
in in
[open] ++ blks ++ [close] [open] ++ blks ++ [close]
makeBlocks b = [b] 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 :: Block -> Block
inlineLetterList (Div a@(_, cs, _) blks) inlineLetterList (Div a@(_, cs, _) blks)