wrote more...

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 56a7adb97459857af218590f925968dc39be2a46..5aa5db4ac90e5d81a13ac28eedd086e90a585766 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -4,11 +4,14 @@ module Rakka.Wiki.Engine
     where
 
 import           Control.Arrow
+import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowTree
 import           Data.Encoding
 import           Data.Encoding.UTF8
 import           Network.HTTP.Lucu
+import           Rakka.Environment
 import           Rakka.Page
+import           Rakka.SystemConfig
 import           Rakka.Wiki.Parser
 import           Rakka.Wiki.Formatter
 import           Text.ParserCombinators.Parsec
@@ -16,24 +19,30 @@ import           Text.XML.HXT.Arrow.XmlArrow
 import           Text.XML.HXT.DOM.TypeDefs
 
 
-formatPage :: (ArrowXml a, ArrowChoice a) =>
-              a Page XmlTree
-formatPage
+formatPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+              Environment
+           -> a Page XmlTree
+formatPage env
     = proc page
     -> do tree <- case pageType page of
                     MIMEType "text" "x-rakka" _
-                        -> formatWikiPage -< page
+                        -> formatWikiPage env -< page
           attachXHtmlNs -< tree
 
 
-formatWikiPage :: (ArrowXml a, ArrowChoice a) =>
-                  a Page XmlTree
-formatWikiPage
+formatWikiPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+                  Environment
+               -> a Page XmlTree
+formatWikiPage env
     = proc page
     -> do let source = decodeLazy UTF8 (pageContent page)
           case parse wikiPage "" source of
-            Left  err   -> formatParseError   -< err
-            Right elems -> formatWikiElements -< elems
+            Left  err
+                -> formatParseError -< err
+
+            Right elems
+                -> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
+                      formatWikiElements -< (baseURI, elems)
 
 
 formatParseError :: ArrowXml a => a ParseError XmlTree