X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FEngine.hs;h=e135f15fa77591b06ce7bda94339c3504f445edd;hb=0b97160b4d55eca16f3c56b47a908997fc458284;hp=90ed666a25db4da0ca9134a4e73b64b154fcc2ef;hpb=7dc6971beb8a9c9fc36a7275d03abf1f1f7c25e5;p=Rakka.git

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 90ed666..e135f15 100644
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -8,17 +8,15 @@ module Rakka.Wiki.Engine
     )
     where
 
-import qualified Codec.Binary.Base64 as B64
 import qualified Codec.Binary.UTF8.String as UTF8
-import           Control.Arrow
-import           Control.Arrow.ArrowIO
-import           Control.Arrow.ArrowList
 import qualified Data.ByteString.Lazy as Lazy
+import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 import           Data.Map (Map)
 import qualified Data.Map as M
 import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.URI
+import           OpenSSL.EVP.Base64
 import           Rakka.Page
 import           Rakka.Storage
 import           Rakka.SystemConfig
@@ -29,8 +27,7 @@ import           Rakka.Wiki.Formatter
 import           Rakka.Wiki.Interpreter
 import           Text.HyperEstraier hiding (getText)
 import           Text.ParserCombinators.Parsec
-import           Text.XML.HXT.Arrow.XmlArrow hiding (err)
-import           Text.XML.HXT.Arrow.XmlNodeSet
+import           Text.XML.HXT.Arrow hiding (err)
 import           Text.XML.HXT.DOM.TypeDefs
 
 
@@ -117,7 +114,7 @@ wikifyBin interpTable
       binToURI m b
           = nullURI {
               uriScheme = "data:"
-            , uriPath   = show m ++ ";base64," ++ B64.encode (Lazy.unpack b)
+            , uriPath   = show m ++ ";base64," ++ (L8.unpack $ encodeBase64LBS b)
             }
 
 
@@ -137,7 +134,7 @@ makeMainXHTML sto sysConf interpTable
           wiki            <- wikifyPage interpTable -< tree
           pName           <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
           interpreted     <- interpretCommands sto sysConf interpTable
-                             -< (pName, Just tree, Just wiki, wiki)
+                             -< (Just pName, Just tree, Just wiki, wiki)
           formatWikiBlocks -< (baseURI, interpreted)
 
 
@@ -145,7 +142,7 @@ makeSubXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                 Storage
              -> SystemConfig
              -> InterpTable
-             -> a (PageName, Maybe XmlTree, XmlTree) XmlTree
+             -> a (Maybe PageName, Maybe XmlTree, XmlTree) XmlTree
 makeSubXHTML sto sysConf interpTable
     = proc (mainPageName, mainPage, subPage)
     -> do BaseURI baseURI <- getSysConfA sysConf -< ()
@@ -171,7 +168,7 @@ makePreviewXHTML sto sysConf interpTable
     -> do BaseURI baseURI <- getSysConfA sysConf -< ()
           wiki            <- wikifyBin interpTable -< (pageType, pageBin)
           interpreted     <- interpretCommands sto sysConf interpTable
-                             -< (name, Nothing, Just wiki, wiki)
+                             -< (Just name, Nothing, Just wiki, wiki)
           formatWikiBlocks -< (baseURI, interpreted)
 
 
@@ -179,7 +176,7 @@ interpretCommands :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                      Storage
                   -> SystemConfig
                   -> InterpTable
-                  -> a (PageName, Maybe XmlTree, Maybe WikiPage, WikiPage) WikiPage
+                  -> a (Maybe PageName, Maybe XmlTree, Maybe WikiPage, WikiPage) WikiPage
 interpretCommands sto sysConf interpTable
     = proc (name, mainPage, mainWiki, targetWiki)
     -> let ctx = InterpreterContext {
@@ -266,7 +263,6 @@ makeDraft interpTable
                pIsBinary <- getXPathTreesInDoc "/page/@isBinary/text()"     >>> getText -< tree
                pRevision <- getXPathTreesInDoc "/page/@revision/text()"     >>> getText -< tree
                pLang     <- maybeA (getXPathTreesInDoc "/page/@lang/text()"     >>> getText) -< tree
-               pFileName <- maybeA (getXPathTreesInDoc "/page/@fileName/text()" >>> getText) -< tree
                pIsTheme  <- maybeA (getXPathTreesInDoc "/page/@isTheme/text()"  >>> getText) -< tree
                pIsFeed   <- maybeA (getXPathTreesInDoc "/page/@isFeed/text()"   >>> getText) -< tree
                pSummary  <- maybeA (getXPathTreesInDoc "/page/summary/text()"   >>> getText) -< tree
@@ -276,7 +272,6 @@ makeDraft interpTable
                arrIO2 (flip setAttribute "@type"         ) -< (doc, Just pType)
                arrIO2 (flip setAttribute "@mdate"        ) -< (doc, Just pLastMod)
                arrIO2 (flip setAttribute "@lang"         ) -< (doc, pLang)
-               arrIO2 (flip setAttribute "rakka:fileName") -< (doc, pFileName)
                arrIO2 (flip setAttribute "rakka:isLocked") -< (doc, Just pIsLocked)
                arrIO2 (flip setAttribute "rakka:isBinary") -< (doc, Just pIsBinary)
                arrIO2 (flip setAttribute "rakka:revision") -< (doc, Just pRevision)
@@ -401,7 +396,7 @@ makePageLinkList sto sysConf interpTable
     -> do wiki            <- wikifyPage interpTable -< tree
           pName           <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
           interpreted     <- interpretCommands sto sysConf interpTable
-                             -< (pName, Just tree, Just wiki, wiki)
+                             -< (Just pName, Just tree, Just wiki, wiki)
           returnA -< concatMap extractFromBlock interpreted
     where
       extractFromElem :: Element -> [PageName]