rhi/lang
1
0
Fork 0
Code Issues 2 Pull requests Releases Wiki Activity

allow <figure>/<aside> to have classes

Browse source
This commit is contained in:
Rhiannon Morris 2023-05-04 02:31:21 +02:00
parent d23e0435aa
commit b9c60a8c42
1 changed files with 21 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
langfilter/Main.hs
View file

@ -1,3 +1,5 @@
{-# LANGUAGE TupleSections #-}
import Lang import Lang
import Ebnf import Ebnf
import Spans import Spans
@ -7,6 +9,8 @@ import Text.Pandoc.Definition
import Text.Pandoc.JSON import Text.Pandoc.JSON
import Text.Pandoc.Walk import Text.Pandoc.Walk
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.Applicative
import qualified Data.Text as Text
main :: IO () main :: IO ()
@ -21,13 +25,24 @@ main = toJSONFilter filter where
walkM (fmap concat . traverse glosses) p walkM (fmap concat . traverse glosses) 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
makeBlocks :: Block -> [Block] makeBlocks :: Block -> [Block]
makeBlocks (Div ("", [cls], []) blks) makeBlocks (Div ("", clss, []) blks)
| cls `elem` ["figure", "aside"] = [open] ++ blks ++ [close] | Just (cls, rest) <- pluck1 ["figure", "aside"] clss =
where let html = RawBlock $ Format "html"
open = html $ "<" <> cls <> ">" open = html $ "<" <> cls <> "class='" <> Text.unwords rest <> "'>"
close = html $ "</" <> cls <> ">" close = html $ "</" <> cls <> ">"
html = RawBlock (Format "html") in
[open] ++ blks ++ [close]
makeBlocks b = [b] makeBlocks b = [b]