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