Implemented more features

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 1246ab1e61b16dc42b368e5f419aa85af70c2da3..7a6bde3bc81c631573bac749f5b933f504e2e281 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -35,8 +35,11 @@ formatBlock
          List list
              -> formatListElement -< (baseURI, list)
 
-         LeadingSpaced inlines
-             -> formatLeadingSpaced -< (baseURI, inlines)
+         DefinitionList list
+             -> formatDefinitionList -< (baseURI, list)
+
+         Preformatted inlines
+             -> formatPreformatted -< (baseURI, inlines)
                 
          Paragraph inlines
              -> formatParagraph -< (baseURI, inlines)
@@ -79,8 +82,35 @@ formatListElement
                  Right inline     -> formatInline      -< (baseURI, inline    )
 
 
-formatLeadingSpaced :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
-formatLeadingSpaced 
+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)
+
+
+formatPreformatted :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
+formatPreformatted
     = eelem "pre"
       += ( (arr fst &&& arrL snd)
            >>>
@@ -104,9 +134,35 @@ 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
+
+
+attrFromPair :: (ArrowXml a) => a (String, String) XmlTree
+attrFromPair = proc (name, value)
+             -> attr name (txt value) -<< ()
+
 
 formatPageLink :: (ArrowXml a) => a (URI, InlineElement) XmlTree
 formatPageLink