1 module Rakka.Environment
10 import Control.Concurrent.STM
11 import Control.Arrow.ArrowIO
13 import qualified Data.Map as M
15 import qualified Network.HTTP.Lucu.Config as LC
17 import Rakka.SystemConfig
18 import Rakka.Wiki.Interpreter
19 import Rakka.Wiki.Interpreter.Base
20 import Subversion.Repository
21 import System.Directory
22 import System.FilePath
23 import System.Log.Logger
25 logger = "Rakka.Environment"
28 data Environment = Environment {
29 envLocalStateDir :: !FilePath
30 , envLucuConf :: !LC.Config
31 , envRepository :: !Repository
32 , envStorage :: !Storage
33 , envSysConf :: !SystemConfig
34 , envInterpTable :: !(TVar InterpTable)
38 type InterpTable = Map String Interpreter
41 setupEnv :: FilePath -> PortNumber -> IO Environment
42 setupEnv lsdir portNum
43 = do let lucuConf = LC.defaultConfig {
44 LC.cnfServerPort = PortNumber portNum
46 reposPath = lsdir `combine` "repos"
49 reposExist <- doesDirectoryExist reposPath
50 repos <- if reposExist then
51 do debugM logger ("Found a subversion repository on " ++ reposPath)
52 openRepository reposPath
54 do noticeM logger ("Creating a subversion repository on " ++ reposPath)
55 createRepository reposPath [] []
56 sysConf <- mkSystemConfig lucuConf repos
57 interpTable <- mkInterpTable
59 return $ Environment {
60 envLocalStateDir = lsdir
61 , envLucuConf = lucuConf
62 , envRepository = repos
63 , envStorage = storage
64 , envSysConf = sysConf
65 , envInterpTable = interpTable
69 mkInterpTable :: IO (TVar InterpTable)
70 mkInterpTable = newTVarIO (listToTable baseInterpreters)
72 listToTable :: [Interpreter] -> InterpTable
74 = M.fromList [ (commandName x, x) | x <- xs ]
77 getInterpTable :: Environment -> IO InterpTable
78 getInterpTable = atomically . readTVar . envInterpTable
81 getInterpTableA :: ArrowIO a => Environment -> a b InterpTable
82 getInterpTableA = arrIO0 . getInterpTable