Rakka/Environment.hs

   1 module Rakka.Environment
   2     ( Environment(..)
   3     , InterpTable
   4     , setupEnv
   5     , getInterpTable
   6     , getInterpTableA
   7     )
   8     where
   9
  10 import           Control.Arrow.ArrowIO
  11 import           Data.IORef
  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
  21
  22 data Environment = Environment {
  23       envLocalStateDir :: !FilePath
  24     , envLucuConf      :: !LC.Config
  25     , envStorage       :: !Storage
  26     , envSysConf       :: !SystemConfig
  27     , envInterpTable   :: !(IORef InterpTable)
  28     }
  29
  30
  31 type InterpTable = Map String Interpreter
  32
  33
  34 setupEnv :: FilePath -> PortNumber -> IO Environment
  35 setupEnv lsdir portNum
  36     = do let lucuConf = LC.defaultConfig {
  37                           LC.cnfServerPort = PortNumber portNum
  38                         }
  39              storage  = mkStorage
  40              sysConf  = mkSystemConfig lucuConf
  41          interpTable <- mkInterpTable
  42          return $ Environment {
  43                       envLocalStateDir = lsdir
  44                     , envLucuConf      = lucuConf
  45                     , envStorage       = storage
  46                     , envSysConf       = sysConf
  47                     , envInterpTable   = interpTable
  48                     }
  49
  50
  51 mkInterpTable :: IO (IORef InterpTable)
  52 mkInterpTable = newIORef (listToTable baseInterpreters)
  53     where
  54       listToTable :: [Interpreter] -> InterpTable
  55       listToTable xs
  56           = M.fromList [ (commandName x, x) | x <- xs ]
  57
  58
  59 getInterpTable :: Environment -> IO InterpTable
  60 getInterpTable = readIORef . envInterpTable
  61
  62
  63 getInterpTableA :: ArrowIO a => Environment -> a b InterpTable
  64 getInterpTableA = arrIO0 . getInterpTable