Exodus to GHC 6.8.1

[Rakka.git] / Rakka / Wiki / Interpreter / Image.hs

diff --git a/Rakka/Wiki/Interpreter/Image.hs b/Rakka/Wiki/Interpreter/Image.hs
index 7f64de00af6c655167def262fb45be3cd61f8912..9b6ff747f63b1f4d0d8886a3a5d3f9abc6b7455f 100644 (file)
--- a/Rakka/Wiki/Interpreter/Image.hs
+++ b/Rakka/Wiki/Interpreter/Image.hs
@@ -26,36 +26,30 @@ imageInterp
     = InlineCommandInterpreter {
         iciName      = "img"
       , iciInterpret
-          = \ ctx (InlineCommand _ attrs inside) ->
-            do BaseURI baseURI <- getSysConf (ctxSysConf ctx) (BaseURI undefined)
+          = \ ctx (InlineCommand _ attrs _) ->
+            do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
 
-               let pageName = lookup "src" attrs
-               when (pageName == Nothing)
-                        $ fail "\"src\" attribute is missing"
-
-               let hrefAttr    = ("href", uriToString id (mkPageURI   baseURI (fromJust pageName)) "")
-                   srcAttr     = ("src" , uriToString id (mkObjectURI baseURI (fromJust pageName)) "")
-                   altAttr     = do alt <- lookup "alt" attrs
-                                    return ("alt", alt)
+               let name        = case lookup "src" attrs of
+                                   Just x  -> x
+                                   Nothing -> error "\"src\" attribute is missing"
+                   hrefAttr    = ("href", uriToString id (mkPageURI baseURI name) "")
+                   alt         = lookup "alt" attrs
                    classAttr   = case lookup "float" attrs of
                                    Nothing      -> ("class", "inlineImage")
                                    Just "left"  -> ("class", "inlineImage leftFloat")
                                    Just "right" -> ("class", "inlineImage rightFloat")
                                    Just others  -> error ("unknown \"float\" attribute: " ++ others)
                    anchorAttrs = [hrefAttr, classAttr]
-                   imgAttrs    = catMaybes [Just srcAttr, altAttr]
 
-               return (Anchor anchorAttrs [Image imgAttrs])
+               return (Anchor anchorAttrs [Image (Right name) alt])
       }
 
 
 -- <div class="imageFrame ...">
 --   <div class="imageData">
---     <p>
---       <a href="...">
---         <img src="..." />
---       </a>
---     </p>
+--     <a href="...">
+--       <img src="..." />
+--     </a>
 --   </div>
 --   <div class="imageCaption">
 --     ...
@@ -67,14 +61,12 @@ imgFrameInterp
         bciName      = "imgframe"
       , bciInterpret
           = \ ctx (BlockCommand _ attrs inside) ->
-            do BaseURI baseURI <- getSysConf (ctxSysConf ctx) (BaseURI undefined)
-
-               let pageName = lookup "src" attrs
-               when (pageName == Nothing)
-                        $ fail "\"src\" attribute is missing"
+            do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
 
-               let hrefAttr    = ("href", uriToString id (mkPageURI   baseURI (fromJust pageName)) "")
-                   srcAttr     = ("src" , uriToString id (mkObjectURI baseURI (fromJust pageName)) "")
+               let name        = case lookup "src" attrs of
+                                   Just x  -> x
+                                   Nothing -> error "\"src\" attribute is missing"
+                   hrefAttr    = ("href", uriToString id (mkPageURI baseURI name) "")
                    classAttr   = case lookup "float" attrs of
                                    Nothing      -> ("class", "imageFrame")
                                    Just "left"  -> ("class", "imageFrame leftFloat")
@@ -82,11 +74,11 @@ imgFrameInterp
                                    Just others  -> error ("unknown \"float\" attribute: " ++ others)
                
                return (Div [classAttr]
-                       [ Div [("class", "imageData")]
-                         [ Paragraph [ Anchor [hrefAttr]
-                                                  [ Image [srcAttr] ] ]
-                         ]
-                       , Div [("class", "imageCaption")] inside
+                       [ Block (Div [("class", "imageData")]
+                                        [ Inline (Anchor [hrefAttr]
+                                                  [ Image (Right name) Nothing ]) ])
+                       , Block (Div [("class", "imageCaption")]
+                                        [ Block x | x <- inside ])
                        ]
                       )
       }