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