X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=367b67365b896d03a2053bcf4ec20ce6f7ce9ca4;hb=9f49e3384f1925d295355e5f60e94a8ca95039ea;hp=1941939d175e7355d5a0e7bb491719cd28876c7c;hpb=ddf0b4d7ab2f1e141edbc7ef75d39853c0846f8c;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 1941939..367b673 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -5,15 +5,20 @@ module Rakka.Environment ) where +import Control.Arrow +import Control.Arrow.ArrowList import qualified Data.Map as M import Network import qualified Network.HTTP.Lucu.Config as LC +import Rakka.Authorization +import Rakka.Page import Rakka.Storage import Rakka.SystemConfig import Rakka.Wiki.Engine import Rakka.Wiki.Interpreter import qualified Rakka.Wiki.Interpreter.Base as Base import qualified Rakka.Wiki.Interpreter.Image as Image +import qualified Rakka.Wiki.Interpreter.PageList as PageList import qualified Rakka.Wiki.Interpreter.Trackback as Trackback import qualified Rakka.Wiki.Interpreter.Outline as Outline import Subversion.Repository @@ -21,8 +26,11 @@ import System.Directory import System.FilePath import System.IO import System.Log.Logger +import Text.HyperEstraier +import Text.XML.HXT.Arrow.XmlIOStateArrow +logger :: String logger = "Rakka.Environment" @@ -33,6 +41,7 @@ data Environment = Environment { , envSysConf :: !SystemConfig , envStorage :: !Storage , envInterpTable :: !InterpTable + , envAuthDB :: !AuthDB } @@ -52,7 +61,8 @@ setupEnv lsdir portNum do noticeM logger ("Creating a subversion repository on " ++ reposPath) createRepository reposPath [] [] sysConf <- mkSystemConfig lucuConf repos - storage <- mkStorage lsdir repos (makeDraft interpTable) + storage <- mkStorage lsdir repos (makeDraft' interpTable) + authDB <- mkAuthDB lsdir return $ Environment { envLocalStateDir = lsdir @@ -61,13 +71,27 @@ setupEnv lsdir portNum , envSysConf = sysConf , envStorage = storage , envInterpTable = interpTable + , envAuthDB = authDB } + where + makeDraft' :: InterpTable -> Page -> IO Document + makeDraft' interpTable page + = do [doc] <- runX ( setErrorMsgHandler False fail + >>> + constA page + >>> + xmlizePage + >>> + makeDraft interpTable + ) + return doc mkInterpTable :: InterpTable mkInterpTable = listToTable $ foldl (++) [] [ Base.interpreters , Image.interpreters + , PageList.interpreters , Trackback.interpreters , Outline.interpreters ]