X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=367b67365b896d03a2053bcf4ec20ce6f7ce9ca4;hb=d843e97aa04278677eaede4e50ef680af32867e7;hp=f8d824b9516b2a94108d10351cb5739de7f05f1f;hpb=98e508613bb7a50a1f65998ce87f065df957b736;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index f8d824b..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 } @@ -41,7 +50,7 @@ setupEnv lsdir portNum = do let lucuConf = LC.defaultConfig { LC.cnfServerPort = PortNumber portNum } - reposPath = lsdir `combine` "repos" + reposPath = lsdir "repos" interpTable = mkInterpTable reposExist <- doesDirectoryExist reposPath @@ -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 ]