X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=b554df8215e4f7ecf23ba93a073031e79f73c56b;hp=d68892b61590336f7e78c22f6dc5836cb35a5f63;hb=3c5211253dc61c31196a47486c538b64c32d8c5e;hpb=b3c3f333cd48bc74eb33f0f21d56a9d1bc65e0ea diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index d68892b..b554df8 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -7,8 +7,8 @@ module Rakka.Environment ) where +import Control.Concurrent.STM import Control.Arrow.ArrowIO -import Data.IORef import Data.Map (Map) import qualified Data.Map as M import Network @@ -17,14 +17,18 @@ import Rakka.Storage import Rakka.SystemConfig import Rakka.Wiki.Interpreter import Rakka.Wiki.Interpreter.Base +import Subversion.Repository +import System.Directory +import System.FilePath data Environment = Environment { envLocalStateDir :: !FilePath , envLucuConf :: !LC.Config + , envRepository :: !Repository , envStorage :: !Storage , envSysConf :: !SystemConfig - , envInterpTable :: !(IORef InterpTable) + , envInterpTable :: !(TVar InterpTable) } @@ -33,23 +37,32 @@ 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 + = do let lucuConf = LC.defaultConfig { + LC.cnfServerPort = PortNumber portNum + } + reposPath = lsdir `combine` "repos" + storage = mkStorage + + reposExist <- doesDirectoryExist reposPath + repos <- if reposExist then + openRepository reposPath + else + createRepository reposPath [] [] + sysConf <- mkSystemConfig lucuConf repos interpTable <- mkInterpTable + return $ Environment { envLocalStateDir = lsdir , envLucuConf = lucuConf + , envRepository = repos , envStorage = storage , envSysConf = sysConf , envInterpTable = interpTable } -mkInterpTable :: IO (IORef InterpTable) -mkInterpTable = newIORef (listToTable baseInterpreters) +mkInterpTable :: IO (TVar InterpTable) +mkInterpTable = newTVarIO (listToTable baseInterpreters) where listToTable :: [Interpreter] -> InterpTable listToTable xs @@ -57,7 +70,7 @@ mkInterpTable = newIORef (listToTable baseInterpreters) getInterpTable :: Environment -> IO InterpTable -getInterpTable = readIORef . envInterpTable +getInterpTable = atomically . readTVar . envInterpTable getInterpTableA :: ArrowIO a => Environment -> a b InterpTable