X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=8d3c16c04fec4e430a286ff91643b579ec7b8341;hb=102d8daa39c593f0ee376c268a9372fc49254a4a;hp=f8d824b9516b2a94108d10351cb5739de7f05f1f;hpb=98e508613bb7a50a1f65998ce87f065df957b736;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index f8d824b..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,15 +40,16 @@ 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 `combine` "repos" + reposPath = lsdir "repos" interpTable = mkInterpTable reposExist <- doesDirectoryExist reposPath @@ -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