X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=e52f4efabe4883fe7f05d6506e3cee2a10a9b23e;hb=ace1b98b247b32e719a72a04fafe9fbffc1c49b0;hp=b554df8215e4f7ecf23ba93a073031e79f73c56b;hpb=3c5211253dc61c31196a47486c538b64c32d8c5e;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index b554df8..e52f4ef 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,10 +12,16 @@ 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.Trackback as Trackback +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 { @@ -28,7 +30,7 @@ data Environment = Environment { , envRepository :: !Repository , envStorage :: !Storage , envSysConf :: !SystemConfig - , envInterpTable :: !(TVar InterpTable) + , envInterpTable :: !InterpTable } @@ -37,19 +39,22 @@ 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 - openRepository reposPath + do debugM logger ("Found a subversion repository on " ++ reposPath) + openRepository reposPath else - createRepository reposPath [] [] + do noticeM logger ("Creating a subversion repository on " ++ reposPath) + createRepository reposPath [] [] sysConf <- mkSystemConfig lucuConf repos - interpTable <- mkInterpTable + return $ Environment { envLocalStateDir = lsdir @@ -61,17 +66,14 @@ setupEnv lsdir portNum } -mkInterpTable :: IO (TVar InterpTable) -mkInterpTable = newTVarIO (listToTable baseInterpreters) +mkInterpTable :: InterpTable +mkInterpTable = listToTable $ + foldl (++) [] [ Base.interpreters + , Image.interpreters + , Trackback.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