Implemented sidebars

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 1da0d0efc12439263a67aaeb817970afc41d1fd2..f0de8fb7b078ac6ae14ded434c47b0399ffd2a75 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -1,5 +1,6 @@
 module Rakka.Wiki.Engine
     ( formatPage
+    , formatSubPage
     )
     where
 
@@ -35,6 +36,18 @@ formatPage env
           attachXHtmlNs -< tree
 
 
+formatSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+                 Environment
+              -> a (Page, Page) XmlTree
+formatSubPage env
+    = proc (mainPage, subPage)
+    -> do tree <- case pageType subPage of
+                    MIMEType "text" "x-rakka" _
+                        -> do let source = decodeLazy UTF8 (pageContent subPage)
+                              formatWikiPage env -< (Just mainPage, source)
+          attachXHtmlNs -< tree
+
+
 formatWikiPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                   Environment
                -> a (Maybe Page, String) XmlTree