The parser of frightening definition list has now been written!

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 1246ab1e61b16dc42b368e5f419aa85af70c2da3..1792299d3c0a09a990ea817fee7078d7aabcdce1 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -35,6 +35,9 @@ formatBlock
          List list
              -> formatListElement -< (baseURI, list)
 
+         DefinitionList list
+             -> formatDefinitionList -< (baseURI, list)
+
          LeadingSpaced inlines
              -> formatLeadingSpaced -< (baseURI, inlines)
                 
@@ -79,6 +82,33 @@ formatListElement
                  Right inline     -> formatInline      -< (baseURI, inline    )
 
 
+formatDefinitionList :: (ArrowXml a, ArrowChoice a) => a (URI, [Definition]) XmlTree
+formatDefinitionList 
+    = proc (baseURI, list)
+    -> ( eelem "dl"
+         += ( (arr fst &&& arrL snd)
+              >>>
+              formatDefinition
+            )
+       ) -< (baseURI, list)
+    where
+      formatDefinition :: (ArrowXml a, ArrowChoice a) => a (URI, Definition) XmlTree
+      formatDefinition 
+          = proc (baseURI, def)
+          -> ( eelem "dt"
+               += ( (arr fst &&& arrL (defTerm . snd))
+                    >>>
+                    formatInline
+                  )
+               <+>
+               eelem "dd"
+               += ( (arr fst &&& arrL (defDesc . snd))
+                    >>>
+                    formatInline
+                  )
+             ) -< (baseURI, def)
+
+
 formatLeadingSpaced :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
 formatLeadingSpaced 
     = eelem "pre"