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