Implemented block commands

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 1792299d3c0a09a990ea817fee7078d7aabcdce1..8a9dc1778eb43ca248a8ba75b52b638f67b0bcaa 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -38,17 +38,31 @@ formatBlock
          DefinitionList list
              -> formatDefinitionList -< (baseURI, list)
 
-         LeadingSpaced inlines
-             -> formatLeadingSpaced -< (baseURI, inlines)
+         Preformatted inlines
+             -> formatPreformatted -< (baseURI, inlines)
                 
          Paragraph inlines
              -> formatParagraph -< (baseURI, inlines)
 
+         Div attrs contents
+             -> ( eelem "div"
+                  += ( arrL (fst . snd)
+                       >>>
+                       attrFromPair
+                     )
+                  += ( (arr fst &&& arrL (snd . snd))
+                       >>>
+                       formatBlock
+                     )
+                ) -< (baseURI, (attrs, contents))
+
 
 formatHeading :: ArrowXml a => a (Int, String) XmlTree
 formatHeading 
     = proc (level, text)
-    -> selem ("h" ++ show level) [txt text] -<< ()
+    -> mkelem ("h" ++ show level)
+       [ sattr "id" text ]
+       [ txt text        ] -<< ()
 
 
 formatListElement :: (ArrowXml a, ArrowChoice a) => a (URI, ListElement) XmlTree
@@ -109,8 +123,8 @@ formatDefinitionList
              ) -< (baseURI, def)
 
 
-formatLeadingSpaced :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
-formatLeadingSpaced 
+formatPreformatted :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
+formatPreformatted
     = eelem "pre"
       += ( (arr fst &&& arrL snd)
            >>>
@@ -134,9 +148,47 @@ formatInline
          Text text
              -> mkText -< text
 
+         Italic inlines
+             -> ( eelem "i"
+                  += ( (arr fst &&& arrL snd)
+                       >>>
+                       formatInline
+                     )
+                ) -< (baseURI, inlines)
+
+         Bold inlines
+             -> ( eelem "b"
+                  += ( (arr fst &&& arrL snd)
+                       >>>
+                       formatInline
+                     )
+                ) -< (baseURI, inlines)
+
          link@(PageLink _ _ _)
              -> formatPageLink -< (baseURI, link)
 
+         LineBreak attrs
+             -> ( eelem "br"
+                  += (arrL id >>> attrFromPair)
+                ) -< attrs
+
+         Span attrs contents
+             -> ( eelem "span"
+                  += ( arrL (fst . snd)
+                       >>>
+                       attrFromPair
+                     )
+                  += ( (arr fst &&& arrL (snd . snd))
+                       >>>
+                       formatInline
+                     )
+                ) -< (baseURI, (attrs, contents))
+
+
+attrFromPair :: (ArrowXml a) => a (String, String) XmlTree
+attrFromPair = proc (name, value)
+             -> attr name (txt value) -<< ()
+
 
 formatPageLink :: (ArrowXml a) => a (URI, InlineElement) XmlTree
 formatPageLink