Implemented block commands

[Rakka.git] / Rakka / Wiki / Engine.hs

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 65009751dde7694c12a52fd4b678f5e5d20261ea..66e2ccc4363cea341c5d8de4cbb82bdea9053219 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -68,10 +68,12 @@ interpretCommands _   _     _    []     = return []
 interpretCommands env table page blocks = mapM interpBlock blocks
     where
       interpBlock :: BlockElement -> IO BlockElement
-      interpBlock (List           list) = interpList list >>= return . List
+      interpBlock (List list)           = interpList list >>= return . List
       interpBlock (DefinitionList defs) = mapM interpDefinition defs >>= return . DefinitionList
-      interpBlock (Preformatted   xs  ) = mapM interpInline xs >>= return . Preformatted
-      interpBlock (Paragraph      xs  ) = mapM interpInline xs >>= return . Paragraph
+      interpBlock (Preformatted xs)     = mapM interpInline xs >>= return . Preformatted
+      interpBlock (Paragraph xs)        = mapM interpInline xs >>= return . Paragraph
+      interpBlock (Div attrs xs)        = mapM interpBlock xs >>= return . Div attrs
+      interpBlock (BlockCmd cmd)        = interpBlockCmd cmd
       interpBlock others                = return others
 
       interpList :: ListElement -> IO ListElement
@@ -92,9 +94,21 @@ interpretCommands env table page blocks = mapM interpBlock blocks
                                 desc <- mapM interpInline (defDesc def)
                                 return $ def { defTerm = term, defDesc = desc }
 
+      interpBlockCmd :: BlockCommand -> IO BlockElement
+      interpBlockCmd cmd
+          = case M.lookup (bCmdName cmd) table of
+              Nothing
+                  -> fail ("no such interpreter: " ++ bCmdName cmd)
+
+              Just interp
+                  -> bciInterpret interp cmd page (envStorage env) (envSysConf env)
+                     >>=
+                     interpBlock
+
       interpInline :: InlineElement -> IO InlineElement
-      interpInline (Italic    xs ) = mapM interpInline xs >>= return . Italic
-      interpInline (Bold      xs ) = mapM interpInline xs >>= return . Bold
+      interpInline (Italic xs)     = mapM interpInline xs >>= return . Italic
+      interpInline (Bold xs )      = mapM interpInline xs >>= return . Bold
+      interpInline (Span attrs xs) = mapM interpInline xs >>= return . Span attrs
       interpInline (InlineCmd cmd) = interpInlineCmd cmd
       interpInline others          = return others