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.PageList  as PageList
  18 import qualified Rakka.Wiki.Interpreter.Trackback as Trackback
  19 import qualified Rakka.Wiki.Interpreter.Outline   as Outline
  20 import           Subversion.Repository
  21 import           System.Directory
  22 import           System.FilePath
  23 import           System.IO
  24 import           System.Log.Logger
  25
  26
  27 logger = "Rakka.Environment"
  28
  29
  30 data Environment = Environment {
  31       envLocalStateDir :: !FilePath
  32     , envLucuConf      :: !LC.Config
  33     , envRepository    :: !Repository
  34     , envSysConf       :: !SystemConfig
  35     , envStorage       :: !Storage
  36     , envInterpTable   :: !InterpTable
  37     }
  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 </> "repos"
  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          storage     <- mkStorage lsdir repos (makeDraft interpTable)
  57
  58          return $ Environment {
  59                       envLocalStateDir = lsdir
  60                     , envLucuConf      = lucuConf
  61                     , envRepository    = repos
  62                     , envSysConf       = sysConf
  63                     , envStorage       = storage
  64                     , envInterpTable   = interpTable
  65                     }
  66
  67
  68 mkInterpTable :: InterpTable
  69 mkInterpTable = listToTable $
  70                 foldl (++) [] [ Base.interpreters
  71                               , Image.interpreters
  72                               , PageList.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 ]