Implemented inline images and framed images

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 8a9dc1778eb43ca248a8ba75b52b638f67b0bcaa..7a7efce40bd4e8c010d308cae1ab2e9617e61da8 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -45,16 +45,23 @@ formatBlock
              -> formatParagraph -< (baseURI, inlines)
 
          Div attrs contents
-             -> ( eelem "div"
-                  += ( arrL (fst . snd)
+             -> formatElem "div" -< (baseURI, attrs, contents)
+    where
+      formatElem :: (ArrowXml a, ArrowChoice a) =>
+                    String
+                 -> a (URI, [Attribute], [BlockElement]) XmlTree
+      formatElem name
+          = proc (baseURI, attrs, contents)
+          -> ( eelem name
+               += ( arrL (fst . snd)
                        >>>
                        attrFromPair
-                     )
-                  += ( (arr fst &&& arrL (snd . snd))
-                       >>>
-                       formatBlock
-                     )
-                ) -< (baseURI, (attrs, contents))
+                  )
+               += ( (arr fst &&& arrL (snd . snd))
+                    >>>
+                    formatBlock
+                  )
+             ) -< (baseURI, (attrs, contents))
 
 
 formatHeading :: ArrowXml a => a (Int, String) XmlTree
@@ -148,41 +155,42 @@ formatInline
          Text text
              -> mkText -< text
 
-         Italic inlines
-             -> ( eelem "i"
-                  += ( (arr fst &&& arrL snd)
-                       >>>
-                       formatInline
-                     )
-                ) -< (baseURI, inlines)
+         Italic contents
+             -> formatElem "i" -< (baseURI, [], contents)
 
-         Bold inlines
-             -> ( eelem "b"
-                  += ( (arr fst &&& arrL snd)
-                       >>>
-                       formatInline
-                     )
-                ) -< (baseURI, inlines)
+         Bold contents
+             -> formatElem "b" -< (baseURI, [], contents)
 
          link@(PageLink _ _ _)
              -> formatPageLink -< (baseURI, link)
 
          LineBreak attrs
-             -> ( eelem "br"
-                  += (arrL id >>> attrFromPair)
-                ) -< attrs
+             -> formatElem "br" -< (baseURI, attrs, [])
 
          Span attrs contents
-             -> ( eelem "span"
-                  += ( arrL (fst . snd)
+             -> formatElem "span" -< (baseURI, attrs, contents)
+
+         Image attrs
+             -> formatElem "img" -< (baseURI, attrs, [])
+
+         Anchor attrs contents
+             -> formatElem "a" -< (baseURI, attrs, contents)
+    where
+      formatElem :: (ArrowXml a, ArrowChoice a) =>
+                    String
+                 -> a (URI, [Attribute], [InlineElement]) XmlTree
+      formatElem name
+          = proc (baseURI, attrs, contents)
+          -> ( eelem name
+               += ( arrL (fst . snd)
                        >>>
                        attrFromPair
-                     )
-                  += ( (arr fst &&& arrL (snd . snd))
-                       >>>
-                       formatInline
-                     )
-                ) -< (baseURI, (attrs, contents))
+                  )
+               += ( (arr fst &&& arrL (snd . snd))
+                    >>>
+                    formatInline
+                  )
+             ) -< (baseURI, (attrs, contents))
 
 
 attrFromPair :: (ArrowXml a) => a (String, String) XmlTree