X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=8d3c16c04fec4e430a286ff91643b579ec7b8341;hb=223d4df57fa1371945075d4d2714e5f36c1fc5dd;hp=1941939d175e7355d5a0e7bb491719cd28876c7c;hpb=ddf0b4d7ab2f1e141edbc7ef75d39853c0846f8c;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 1941939..8d3c16c 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -5,24 +5,31 @@ module Rakka.Environment ) where +import Control.Arrow +import Control.Arrow.ArrowList import qualified Data.Map as M -import Network +import Network.Socket 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.Trackback as Trackback +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 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,13 +40,14 @@ data Environment = Environment { , envSysConf :: !SystemConfig , envStorage :: !Storage , envInterpTable :: !InterpTable + , envAuthDB :: !AuthDB } -setupEnv :: FilePath -> PortNumber -> IO Environment +setupEnv :: FilePath -> ServiceName -> IO Environment setupEnv lsdir portNum = do let lucuConf = LC.defaultConfig { - LC.cnfServerPort = PortNumber portNum + LC.cnfServerPort = portNum } reposPath = lsdir "repos" interpTable = mkInterpTable @@ -52,23 +60,38 @@ 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 { + return Environment { envLocalStateDir = lsdir , envLucuConf = lucuConf , envRepository = repos , 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 - , Trackback.interpreters + , PageList.interpreters + --, Trackback.interpreters , Outline.interpreters ] where