Rakka/Environment.hs

   1 module Rakka.Environment
   2     ( Environment(..)
   3     , InterpTable
   4     , setupEnv
   5     )
   6     where
   7
   8 import           Control.Arrow
   9 import           Control.Arrow.ArrowList
  10 import qualified Data.Map as M
  11 import           Network.Socket
  12 import qualified Network.HTTP.Lucu.Config as LC
  13 import           Rakka.Authorization
  14 import           Rakka.Page
  15 import           Rakka.Storage
  16 import           Rakka.SystemConfig
  17 import           Rakka.Wiki.Engine
  18 import           Rakka.Wiki.Interpreter
  19 import qualified Rakka.Wiki.Interpreter.Base      as Base
  20 import qualified Rakka.Wiki.Interpreter.Image     as Image
  21 import qualified Rakka.Wiki.Interpreter.PageList  as PageList
  22 import qualified Rakka.Wiki.Interpreter.Outline   as Outline
  23 import           Subversion.Repository
  24 import           System.Directory
  25 import           System.FilePath
  26 import           System.Log.Logger
  27 import           Text.HyperEstraier
  28
  29
  30 logger :: String
  31 logger = "Rakka.Environment"
  32
  33
  34 data Environment = Environment {
  35       envLocalStateDir :: !FilePath
  36     , envLucuConf      :: !LC.Config
  37     , envRepository    :: !Repository
  38     , envSysConf       :: !SystemConfig
  39     , envStorage       :: !Storage
  40     , envInterpTable   :: !InterpTable
  41     , envAuthDB        :: !AuthDB
  42     }
  43
  44
  45 setupEnv :: FilePath -> ServiceName -> IO Environment
  46 setupEnv lsdir portNum
  47     = do let lucuConf    = LC.defaultConfig {
  48                              LC.cnfServerPort = portNum
  49                            }
  50              reposPath   = lsdir </> "repos"
  51              interpTable = mkInterpTable
  52
  53          reposExist  <- doesDirectoryExist reposPath
  54          repos       <- if reposExist then
  55                             do debugM logger ("Found a subversion repository on " ++ reposPath)
  56                                openRepository reposPath
  57                         else
  58                             do noticeM logger ("Creating a subversion repository on " ++ reposPath)
  59                                createRepository reposPath [] []
  60          sysConf     <- mkSystemConfig lucuConf repos
  61          storage     <- mkStorage lsdir repos (makeDraft' interpTable)
  62          authDB      <- mkAuthDB lsdir
  63
  64          return Environment {
  65                       envLocalStateDir = lsdir
  66                     , envLucuConf      = lucuConf
  67                     , envRepository    = repos
  68                     , envSysConf       = sysConf
  69                     , envStorage       = storage
  70                     , envInterpTable   = interpTable
  71                     , envAuthDB        = authDB
  72                     }
  73     where
  74       makeDraft' :: InterpTable -> Page -> IO Document
  75       makeDraft' interpTable page
  76           = do [doc] <- runX ( setErrorMsgHandler False fail
  77                                >>>
  78                                constA page
  79                                >>>
  80                                xmlizePage
  81                                >>>
  82                                makeDraft interpTable
  83                              )
  84                return doc
  85
  86
  87 mkInterpTable :: InterpTable
  88 mkInterpTable = listToTable $
  89                 foldl (++) [] [ Base.interpreters
  90                               , Image.interpreters
  91                               , PageList.interpreters
  92                               --, Trackback.interpreters
  93                               , Outline.interpreters
  94                               ]
  95     where
  96       listToTable :: [Interpreter] -> InterpTable
  97       listToTable xs
  98           = M.fromList [ (commandName x, x) | x <- xs ]