X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;fp=Rakka%2FEnvironment.hs;h=48105b4a6d2b840e43e2b87bb7ddedf51c2d4f4b;hb=8f77b5949ccd5f2272a02c852d51bfa2ecfa84c8;hp=6ae6f11c708a61f7c6007326382394599d5ae5ff;hpb=4e8a07033b0b0ea0961bffb3bab0b6fc9c21afba;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 6ae6f11..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.Concurrent.STM -import Control.Arrow.ArrowIO import Data.Map (Map) import qualified Data.Map as M import Network @@ -16,7 +12,9 @@ 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 @@ -31,7 +29,7 @@ data Environment = Environment { , envRepository :: !Repository , envStorage :: !Storage , envSysConf :: !SystemConfig - , envInterpTable :: !(TVar InterpTable) + , envInterpTable :: !InterpTable } @@ -40,11 +38,12 @@ type InterpTable = Map String Interpreter setupEnv :: FilePath -> PortNumber -> IO Environment setupEnv lsdir portNum - = do let lucuConf = LC.defaultConfig { - LC.cnfServerPort = PortNumber portNum - } - reposPath = lsdir `combine` "repos" - storage = mkStorage + = do let lucuConf = LC.defaultConfig { + LC.cnfServerPort = PortNumber portNum + } + reposPath = lsdir `combine` "repos" + storage = mkStorage + interpTable = mkInterpTable reposExist <- doesDirectoryExist reposPath repos <- if reposExist then @@ -54,7 +53,7 @@ setupEnv lsdir portNum do noticeM logger ("Creating a subversion repository on " ++ reposPath) createRepository reposPath [] [] sysConf <- mkSystemConfig lucuConf repos - interpTable <- mkInterpTable + return $ Environment { envLocalStateDir = lsdir @@ -66,17 +65,13 @@ setupEnv lsdir portNum } -mkInterpTable :: IO (TVar InterpTable) -mkInterpTable = newTVarIO (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 = atomically . readTVar . envInterpTable - - -getInterpTableA :: ArrowIO a => Environment -> a b InterpTable -getInterpTableA = arrIO0 . getInterpTable