Wrote more

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

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index b81c510594f75253678f9dfc7995899e627615c5..cc51feff644c86a6f3d714adb1bdb27955b098e7 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -166,6 +166,9 @@ formatInline
          Bold contents
              -> formatElem "b" -< (baseURI, [], contents)
 
+         link@(ObjectLink _ _)
+             -> formatObjectLink -< (baseURI, link)
+
          link@(PageLink _ _ _)
              -> formatPageLink -< (baseURI, link)
 
@@ -178,8 +181,8 @@ formatInline
          Span attrs contents
              -> formatElem "span" -< (baseURI, attrs, contents)
 
-         Image attrs
-             -> formatElem "img" -< (baseURI, attrs, [])
+         img@(Image _ _)
+             -> formatImage -< (baseURI, img)
 
          Anchor attrs contents
              -> formatElem "a" -< (baseURI, attrs, contents)
@@ -209,22 +212,42 @@ attrFromPair = proc (name, value)
              -> attr name (txt value) -<< ()
 
 
+formatObjectLink :: (ArrowXml a) => a (URI, InlineElement) XmlTree
+formatObjectLink 
+    = proc (baseURI, ObjectLink page text)
+    -> let uri   = mkObjectURI baseURI page
+           href  = uriToString id uri ""
+           label = fromMaybe ("{" ++ page ++ "}") text
+       in
+         mkAnchor -< (href, label)
+
+
 formatPageLink :: (ArrowXml a) => a (URI, InlineElement) XmlTree
 formatPageLink 
     = proc (baseURI, PageLink page fragment text)
     -> let uri    = case (page, fragment) of
-                      (Just  x, Just  y) -> mkPageFragmentURI baseURI (fix x) y
-                      (Just  x, Nothing) -> mkPageURI baseURI (fix x)
+                      (Just  x, Just  y) -> mkPageFragmentURI baseURI x y
+                      (Just  x, Nothing) -> mkPageURI baseURI x
                       (Nothing, Just  y) -> nullURI { uriFragment = ('#':y) }
-           fix    = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
            href   = uriToString id uri ""
            dLabel = fromMaybe "" page ++ fromMaybe "" (fmap ('#':) fragment)
            label  = fromMaybe dLabel text
        in
-         ( eelem "a"
-           += attr "href" (arr fst >>> mkText)
-           += (arr snd >>> mkText)
-         ) -< (href, label)
+         mkAnchor -< (href, label)
+
+
+formatImage :: (ArrowXml a) => a (URI, InlineElement) XmlTree
+formatImage = proc (baseURI, Image name alt)
+            -> let uri  = mkObjectURI baseURI name
+                   href = uriToString id uri ""
+               in
+                 ( eelem "img"
+                   += sattr "src" href
+                   += ( case alt of
+                          Just x  -> sattr "alt" x
+                          Nothing -> none
+                      )
+                 ) -<< ()
 
 
 formatExternalLink :: (ArrowXml a) => a InlineElement XmlTree
@@ -233,10 +256,13 @@ formatExternalLink
     -> let href  = uriToString id uri ""
            label = fromMaybe href text
        in
-         ( eelem "a"
+         mkAnchor -< (href, label)
+
+
+mkAnchor :: (ArrowXml a) => a (String, String) XmlTree
+mkAnchor = eelem "a"
            += attr "href" (arr fst >>> mkText)
            += (arr snd >>> mkText)
-         ) -< (href, label)
 
 
 attachXHtmlNs :: ArrowXml a => a XmlTree XmlTree