Rakka/Environment.hs

   1 module Rakka.Environment
   2     ( Environment(..)
   3     , InterpTable
   4     , setupEnv
   5     )
   6     where
   7
   8 import           Data.Map (Map)
   9 import qualified Data.Map as M
  10 import           Network
  11 import qualified Network.HTTP.Lucu.Config as LC
  12 import           Rakka.Storage
  13 import           Rakka.SystemConfig
  14 import           Rakka.Wiki.Interpreter
  15 import qualified Rakka.Wiki.Interpreter.Base    as Base
  16 import qualified Rakka.Wiki.Interpreter.Image   as Image
  17 import qualified Rakka.Wiki.Interpreter.Outline as Outline
  18 import           Subversion.Repository
  19 import           System.Directory
  20 import           System.FilePath
  21 import           System.Log.Logger
  22
  23 logger = "Rakka.Environment"
  24
  25
  26 data Environment = Environment {
  27       envLocalStateDir :: !FilePath
  28     , envLucuConf      :: !LC.Config
  29     , envRepository    :: !Repository
  30     , envStorage       :: !Storage
  31     , envSysConf       :: !SystemConfig
  32     , envInterpTable   :: !InterpTable
  33     }
  34
  35
  36 type InterpTable = Map String Interpreter
  37
  38
  39 setupEnv :: FilePath -> PortNumber -> IO Environment
  40 setupEnv lsdir portNum
  41     = do let lucuConf    = LC.defaultConfig {
  42                              LC.cnfServerPort = PortNumber portNum
  43                            }
  44              reposPath   = lsdir `combine` "repos"
  45              storage     = mkStorage
  46              interpTable = mkInterpTable
  47
  48          reposExist  <- doesDirectoryExist reposPath
  49          repos       <- if reposExist then
  50                             do debugM logger ("Found a subversion repository on " ++ reposPath)
  51                                openRepository reposPath
  52                         else
  53                             do noticeM logger ("Creating a subversion repository on " ++ reposPath)
  54                                createRepository reposPath [] []
  55          sysConf     <- mkSystemConfig lucuConf repos
  56
  57
  58          return $ Environment {
  59                       envLocalStateDir = lsdir
  60                     , envLucuConf      = lucuConf
  61                     , envRepository    = repos
  62                     , envStorage       = storage
  63                     , envSysConf       = sysConf
  64                     , envInterpTable   = interpTable
  65                     }
  66
  67
  68 mkInterpTable :: InterpTable
  69 mkInterpTable = listToTable $
  70                 foldl (++) [] [ Base.interpreters
  71                               , Image.interpreters
  72                               , Outline.interpreters
  73                               ]
  74     where
  75       listToTable :: [Interpreter] -> InterpTable
  76       listToTable xs
  77           = M.fromList [ (commandName x, x) | x <- xs ]