Rakka/Environment.hs

   1 module Rakka.Environment
   2     ( Environment(..)
   3     , InterpTable
   4     , setupEnv
   5     , getInterpTable
   6     , getInterpTableA
   7     )
   8     where
   9
  10 import           Control.Concurrent.STM
  11 import           Control.Arrow.ArrowIO
  12 import           Data.Map (Map)
  13 import qualified Data.Map as M
  14 import           Network
  15 import qualified Network.HTTP.Lucu.Config as LC
  16 import           Rakka.Storage
  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
  24
  25 data Environment = Environment {
  26       envLocalStateDir :: !FilePath
  27     , envLucuConf      :: !LC.Config
  28     , envRepository    :: !Repository
  29     , envStorage       :: !Storage
  30     , envSysConf       :: !SystemConfig
  31     , envInterpTable   :: !(TVar InterpTable)
  32     }
  33
  34
  35 type InterpTable = Map String Interpreter
  36
  37
  38 setupEnv :: FilePath -> PortNumber -> IO Environment
  39 setupEnv lsdir portNum
  40     = do let lucuConf  = LC.defaultConfig {
  41                            LC.cnfServerPort = PortNumber portNum
  42                          }
  43              reposPath = lsdir `combine` "repos"
  44              storage   = mkStorage
  45
  46          reposExist  <- doesDirectoryExist reposPath
  47          repos       <- if reposExist then
  48                             openRepository reposPath
  49                         else
  50                             createRepository reposPath [] []
  51          sysConf     <- mkSystemConfig lucuConf repos
  52          interpTable <- mkInterpTable
  53
  54          return $ Environment {
  55                       envLocalStateDir = lsdir
  56                     , envLucuConf      = lucuConf
  57                     , envRepository    = repos
  58                     , envStorage       = storage
  59                     , envSysConf       = sysConf
  60                     , envInterpTable   = interpTable
  61                     }
  62
  63
  64 mkInterpTable :: IO (TVar InterpTable)
  65 mkInterpTable = newTVarIO (listToTable baseInterpreters)
  66     where
  67       listToTable :: [Interpreter] -> InterpTable
  68       listToTable xs
  69           = M.fromList [ (commandName x, x) | x <- xs ]
  70
  71
  72 getInterpTable :: Environment -> IO InterpTable
  73 getInterpTable = atomically . readTVar . envInterpTable
  74
  75
  76 getInterpTableA :: ArrowIO a => Environment -> a b InterpTable
  77 getInterpTableA = arrIO0 . getInterpTable