X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FEngine.hs;h=dae6471043c9f6ca4272d3f1b4338e4123efc373;hb=88747f2463963ff2895a597b3054b12b2288530e;hp=27386961fe4e7416623e6d752679c0579adf56f6;hpb=f57c5c5ae6c95e68b11400718e7ce5de4ea1317a;p=Rakka.git diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs index 2738696..dae6471 100644 --- a/Rakka/Wiki/Engine.hs +++ b/Rakka/Wiki/Engine.hs @@ -7,18 +7,14 @@ module Rakka.Wiki.Engine , makeDraft ) 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 +25,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.DOM.TypeDefs +import Text.XML.HXT.XPath type InterpTable = Map String Interpreter @@ -117,7 +111,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 +131,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 +139,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 +165,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 +173,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 +393,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]