X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=48105b4a6d2b840e43e2b87bb7ddedf51c2d4f4b;hb=8f77b5949ccd5f2272a02c852d51bfa2ecfa84c8;hp=d68892b61590336f7e78c22f6dc5836cb35a5f63;hpb=2ad43b49ecc25bdf87dd19037fd63c12428992ae;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index d68892b..48105b4 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -2,13 +2,9 @@ module Rakka.Environment ( Environment(..) , InterpTable , setupEnv - , getInterpTable - , getInterpTableA ) where -import Control.Arrow.ArrowIO -import Data.IORef import Data.Map (Map) import qualified Data.Map as M import Network @@ -16,15 +12,24 @@ import qualified Network.HTTP.Lucu.Config as LC import Rakka.Storage import Rakka.SystemConfig import Rakka.Wiki.Interpreter -import Rakka.Wiki.Interpreter.Base +import qualified Rakka.Wiki.Interpreter.Base as Base +import qualified Rakka.Wiki.Interpreter.Image as Image +import qualified Rakka.Wiki.Interpreter.Outline as Outline +import Subversion.Repository +import System.Directory +import System.FilePath +import System.Log.Logger + +logger = "Rakka.Environment" data Environment = Environment { envLocalStateDir :: !FilePath , envLucuConf :: !LC.Config + , envRepository :: !Repository , envStorage :: !Storage , envSysConf :: !SystemConfig - , envInterpTable :: !(IORef InterpTable) + , envInterpTable :: !InterpTable } @@ -33,32 +38,40 @@ type InterpTable = Map String Interpreter setupEnv :: FilePath -> PortNumber -> IO Environment setupEnv lsdir portNum - = do let lucuConf = LC.defaultConfig { - LC.cnfServerPort = PortNumber portNum - } - storage = mkStorage - sysConf = mkSystemConfig lucuConf - interpTable <- mkInterpTable + = do let lucuConf = LC.defaultConfig { + LC.cnfServerPort = PortNumber portNum + } + reposPath = lsdir `combine` "repos" + storage = mkStorage + interpTable = mkInterpTable + + reposExist <- doesDirectoryExist reposPath + repos <- if reposExist then + do debugM logger ("Found a subversion repository on " ++ reposPath) + openRepository reposPath + else + do noticeM logger ("Creating a subversion repository on " ++ reposPath) + createRepository reposPath [] [] + sysConf <- mkSystemConfig lucuConf repos + + return $ Environment { envLocalStateDir = lsdir , envLucuConf = lucuConf + , envRepository = repos , envStorage = storage , envSysConf = sysConf , envInterpTable = interpTable } -mkInterpTable :: IO (IORef InterpTable) -mkInterpTable = newIORef (listToTable baseInterpreters) +mkInterpTable :: InterpTable +mkInterpTable = listToTable $ + foldl (++) [] [ Base.interpreters + , Image.interpreters + , Outline.interpreters + ] where listToTable :: [Interpreter] -> InterpTable listToTable xs = M.fromList [ (commandName x, x) | x <- xs ] - - -getInterpTable :: Environment -> IO InterpTable -getInterpTable = readIORef . envInterpTable - - -getInterpTableA :: ArrowIO a => Environment -> a b InterpTable -getInterpTableA = arrIO0 . getInterpTable