Rakka/Environment.hs

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