implemented listing

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 8d219d2a8e39b19b3a77893ce60ca99cb01db8a7..1246ab1e61b16dc42b368e5f419aa85af70c2da3 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -28,6 +28,15 @@ formatBlock
     -> case block of
          Heading level text
              -> formatHeading -< (level, text)
+
+         HorizontalLine
+             -> eelem "hr" -< ()
+
+         List list
+             -> formatListElement -< (baseURI, list)
+
+         LeadingSpaced inlines
+             -> formatLeadingSpaced -< (baseURI, inlines)
                 
          Paragraph inlines
              -> formatParagraph -< (baseURI, inlines)
@@ -39,6 +48,46 @@ formatHeading
     -> selem ("h" ++ show level) [txt text] -<< ()
 
 
+formatListElement :: (ArrowXml a, ArrowChoice a) => a (URI, ListElement) XmlTree
+formatListElement 
+    = proc (baseURI, list)
+    -> let tag = case listType list of
+                   Bullet   -> "ul"
+                   Numbered -> "ol"
+       in
+         ( eelem tag
+           += ( (constA baseURI &&& constL (listItems list))
+                >>>
+                formatListItem
+              )
+         ) -<< ()
+      where
+        formatListItem :: (ArrowXml a, ArrowChoice a) => a (URI, ListItem) XmlTree
+        formatListItem 
+            = proc (baseURI, item)
+            -> eelem "li"
+               += ( (arr fst &&& arrL snd)
+                    >>>
+                    formatListItem'
+                  ) -< (baseURI, item)
+
+        formatListItem' :: (ArrowXml a, ArrowChoice a) => a (URI, Either ListElement InlineElement) XmlTree
+        formatListItem' 
+            = proc (baseURI, x)
+            -> case x of
+                 Left  nestedList -> formatListElement -< (baseURI, nestedList)
+                 Right inline     -> formatInline      -< (baseURI, inline    )
+
+
+formatLeadingSpaced :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
+formatLeadingSpaced 
+    = eelem "pre"
+      += ( (arr fst &&& arrL snd)
+           >>>
+           formatInline
+         )
+
+
 formatParagraph :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
 formatParagraph 
     = eelem "p"