Wrote many

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

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 0f18fb1187fe3df6e3c2733441314b4116af9551..07eaff4a594ed5c5ff112f1550997e533bffe6df 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -53,6 +53,7 @@ formatEntirePage sto sysConf interpTable
           tree <- ( eelem "/"
                     += ( eelem "page"
                          += sattr "site"       siteName
+                         += sattr "baseURI"    (uriToString id baseURI "")
                          += sattr "name"       (pageName page)
                          += sattr "type"       (show $ pageType page)
                          += ( case pageLanguage page of
@@ -128,6 +129,7 @@ formatEntirePage sto sysConf interpTable
                          += ( eelem "body"
                               += (constA page >>> formatMainPage sto sysConf interpTable)
                             )
+                         += (constA page >>> formatSource)
                          >>>
                          uniqueNamespacesFromDeclAndQNames
                        )
@@ -135,6 +137,16 @@ formatEntirePage sto sysConf interpTable
           returnA -< tree
 
 
+formatSource :: (ArrowXml a, ArrowChoice a) => a Page XmlTree
+formatSource = proc page
+             -> if pageIsBinary page then
+                    none -< ()
+                else
+                    let source = decodeLazy UTF8 (pageContent page)
+                    in
+                      ( eelem "source" += mkText ) -< source
+
+
 formatUnexistentPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                         Storage
                      -> SystemConfig
@@ -152,9 +164,21 @@ formatUnexistentPage sto sysConf interpTable
 
           tree <- ( eelem "/"
                     += ( eelem "pageNotFound"
-                         += sattr "site"       siteName
-                         += sattr "styleSheet" (uriToString id (mkObjectURI baseURI cssName) "")
-                         += sattr "name"       name
+                         += sattr "site"    siteName
+                         += sattr "baseURI" (uriToString id baseURI "")
+                         += sattr "name"    name
+
+                         += ( eelem "styleSheets"
+                              += ( eelem "styleSheet"
+                                   += sattr "src" (uriToString id (mkObjectURI baseURI cssName) "")
+                                 )
+                            )
+
+                         += ( eelem "scripts"
+                              += ( eelem "script"
+                                   += sattr "src" (uriToString id (baseURI { uriPath = "/js" }) "")
+                                 )
+                            )
                          
                          += ( eelem "pageTitle"
                               += ( (constA name &&& constA Nothing &&& constA pageTitle)