allow <figure>/<aside> to have classes

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]