X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=6ae6f11c708a61f7c6007326382394599d5ae5ff;hb=0b1235464affca4fb349c713278d2e37fd8e9584;hp=e793d0001f401b7e07a1c0b4fd9c38bc10787a4b;hpb=484e15845d9c06d0fa62044d3b6b3ff8c78a6e04;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index e793d00..6ae6f11 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -1,29 +1,82 @@ module Rakka.Environment ( Environment(..) + , InterpTable , setupEnv + , getInterpTable + , getInterpTableA ) where +import Control.Concurrent.STM +import Control.Arrow.ArrowIO +import Data.Map (Map) +import qualified Data.Map as M import Network import qualified Network.HTTP.Lucu.Config as LC import Rakka.Storage +import Rakka.SystemConfig +import Rakka.Wiki.Interpreter +import Rakka.Wiki.Interpreter.Base +import Subversion.Repository +import System.Directory +import System.FilePath +import System.Log.Logger + +logger = "Rakka.Environment" data Environment = Environment { - envLocalStateDir :: FilePath - , envLucuConf :: LC.Config - , envStorage :: Storage + envLocalStateDir :: !FilePath + , envLucuConf :: !LC.Config + , envRepository :: !Repository + , envStorage :: !Storage + , envSysConf :: !SystemConfig + , envInterpTable :: !(TVar InterpTable) } +type InterpTable = Map String Interpreter + + setupEnv :: FilePath -> PortNumber -> IO Environment setupEnv lsdir portNum - = do let lucuConf = LC.defaultConfig { - LC.cnfServerPort = PortNumber portNum - } - storage <- mkStorage -- FIXME + = do let lucuConf = LC.defaultConfig { + LC.cnfServerPort = PortNumber portNum + } + reposPath = lsdir `combine` "repos" + storage = mkStorage + + 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 + interpTable <- mkInterpTable + return $ Environment { envLocalStateDir = lsdir , envLucuConf = lucuConf + , envRepository = repos , envStorage = storage - } \ No newline at end of file + , envSysConf = sysConf + , envInterpTable = interpTable + } + + +mkInterpTable :: IO (TVar InterpTable) +mkInterpTable = newTVarIO (listToTable baseInterpreters) + where + listToTable :: [Interpreter] -> InterpTable + listToTable xs + = M.fromList [ (commandName x, x) | x <- xs ] + + +getInterpTable :: Environment -> IO InterpTable +getInterpTable = atomically . readTVar . envInterpTable + + +getInterpTableA :: ArrowIO a => Environment -> a b InterpTable +getInterpTableA = arrIO0 . getInterpTable