X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FEngine.hs;h=17c2933852ee5273485ac80fcbb570c36f6bd080;hb=fcddebcc3cc02ae8d1904b9338334d538019e74a;hp=27386961fe4e7416623e6d752679c0579adf56f6;hpb=f57c5c5ae6c95e68b11400718e7ce5de4ea1317a;p=Rakka.git

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 2738696..17c2933 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,9 +27,8 @@ 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.DOM.TypeDefs
+import           Text.XML.HXT.Arrow hiding (err)
+import           Text.XML.HXT.XPath
 
 
 type InterpTable = Map String Interpreter
@@ -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 {
@@ -399,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]