( 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 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
, envRepository :: !Repository
, envStorage :: !Storage
, envSysConf :: !SystemConfig
- , envInterpTable :: !(TVar InterpTable)
+ , envInterpTable :: !InterpTable
}
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
do noticeM logger ("Creating a subversion repository on " ++ reposPath)
createRepository reposPath [] []
sysConf <- mkSystemConfig lucuConf repos
- interpTable <- mkInterpTable
+
return $ Environment {
envLocalStateDir = lsdir
}
-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