module Rakka.Environment
( Environment(..)
+ , InterpTable
, setupEnv
-
- , getSiteName
- , getSiteNameA
-
- , getBaseURI
- , getBaseURIA
+ , getInterpTable
+ , getInterpTableA
)
where
+import Control.Concurrent.STM
import Control.Arrow.ArrowIO
-import qualified Data.ByteString.Char8 as C8
-import Data.Maybe
+import Data.Map (Map)
+import qualified Data.Map as M
import Network
import qualified Network.HTTP.Lucu.Config as LC
-import Network.URI
import Rakka.Storage
+import Rakka.SystemConfig
+import Rakka.Wiki.Interpreter
+import Rakka.Wiki.Interpreter.Base
+import Subversion.Repository
+import System.Directory
+import System.FilePath
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
+ openRepository reposPath
+ else
+ createRepository reposPath [] []
+ sysConf <- mkSystemConfig lucuConf repos
+ interpTable <- mkInterpTable
+
return $ Environment {
envLocalStateDir = lsdir
, envLucuConf = lucuConf
+ , envRepository = repos
, envStorage = storage
+ , envSysConf = sysConf
+ , envInterpTable = interpTable
}
-getSiteName :: Environment -> IO String
-getSiteName env
- = return "Rakka" -- FIXME
-
-
-getSiteNameA :: ArrowIO a => Environment -> a b String
-getSiteNameA = arrIO0 . getSiteName
-
+mkInterpTable :: IO (TVar InterpTable)
+mkInterpTable = newTVarIO (listToTable baseInterpreters)
+ where
+ listToTable :: [Interpreter] -> InterpTable
+ listToTable xs
+ = M.fromList [ (commandName x, x) | x <- xs ]
-getBaseURI :: Environment -> IO URI
-getBaseURI env
- = do let conf = envLucuConf env
- host = C8.unpack $ LC.cnfServerHost conf
- port = case LC.cnfServerPort conf of
- PortNumber num -> fromIntegral num
-
- defaultURI
- = "http://" ++ host ++
- (if port == 80
- then ""
- else ':' : show port) ++ "/"
- return $ fromJust $ parseURI defaultURI -- FIXME
+getInterpTable :: Environment -> IO InterpTable
+getInterpTable = atomically . readTVar . envInterpTable
-getBaseURIA :: ArrowIO a => Environment -> a b URI
-getBaseURIA = arrIO0 . getBaseURI
\ No newline at end of file
+getInterpTableA :: ArrowIO a => Environment -> a b InterpTable
+getInterpTableA = arrIO0 . getInterpTable