X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=9a6df3a396fd3276156178227adcfcc22bab926f;hb=88747f2;hp=f8d824b9516b2a94108d10351cb5739de7f05f1f;hpb=98e508613bb7a50a1f65998ce87f065df957b736;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index f8d824b..9a6df3a 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -5,24 +5,29 @@ 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.Outline as Outline import Subversion.Repository import System.Directory import System.FilePath -import System.IO import System.Log.Logger +import Text.HyperEstraier +logger :: String logger = "Rakka.Environment" @@ -33,15 +38,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 +58,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