Rakka/Environment.hs

   1 {-# LANGUAGE
   2     UnicodeSyntax
   3   #-}
   4 module Rakka.Environment
   5     ( Environment(..)
   6     , InterpTable
   7     , setupEnv
   8     )
   9     where
  10 import Control.Arrow.ArrowList
  11 import Control.Arrow.Unicode
  12 import qualified Data.Map as M
  13 import Network.Socket
  14 import qualified Network.HTTP.Lucu.Config as LC
  15 import           Rakka.Authorization
  16 import           Rakka.Page
  17 import           Rakka.Storage
  18 import           Rakka.SystemConfig
  19 import           Rakka.Wiki.Engine
  20 import           Rakka.Wiki.Interpreter
  21 import qualified Rakka.Wiki.Interpreter.Base      as Base
  22 import qualified Rakka.Wiki.Interpreter.Image     as Image
  23 import qualified Rakka.Wiki.Interpreter.PageList  as PageList
  24 import qualified Rakka.Wiki.Interpreter.Outline   as Outline
  25 import           Subversion.Repository
  26 import           System.Directory
  27 import           System.FilePath
  28 import           System.Log.Logger
  29 import           Text.HyperEstraier
  30 import Text.XML.HXT.Arrow.XmlState
  31
  32 logger :: String
  33 logger = "Rakka.Environment"
  34
  35
  36 data Environment = Environment {
  37       envLocalStateDir :: !FilePath
  38     , envLucuConf      :: !LC.Config
  39     , envRepository    :: !Repository
  40     , envSysConf       :: !SystemConfig
  41     , envStorage       :: !Storage
  42     , envInterpTable   :: !InterpTable
  43     , envAuthDB        :: !AuthDB
  44     }
  45
  46 setupEnv ∷ FilePath → ServiceName → IO Environment
  47 setupEnv lsdir port
  48     = do let lucuConf    = LC.defaultConfig {
  49                              LC.cnfServerPort = port
  50                            }
  51              reposPath   = lsdir </> "repos"
  52              interpTable = mkInterpTable
  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          return Environment {
  64                       envLocalStateDir = lsdir
  65                     , envLucuConf      = lucuConf
  66                     , envRepository    = repos
  67                     , envSysConf       = sysConf
  68                     , envStorage       = storage
  69                     , envInterpTable   = interpTable
  70                     , envAuthDB        = authDB
  71                     }
  72     where
  73       makeDraft' ∷ InterpTable → Page → IO Document
  74       makeDraft' interpTable page
  75           = do [doc] ← runX ( setErrorMsgHandler False fail
  76                               ⋙
  77                               constA page
  78                               ⋙
  79                               xmlizePage
  80                               ⋙
  81                               makeDraft interpTable
  82                             )
  83                return doc
  84
  85 mkInterpTable ∷ InterpTable
  86 mkInterpTable = listToTable $
  87                 concat [ Base.interpreters
  88                        , Image.interpreters
  89                        , PageList.interpreters
  90                        , Outline.interpreters
  91                        ]
  92     where
  93       listToTable ∷ [Interpreter] → InterpTable
  94       listToTable xs
  95           = M.fromList [ (commandName x, x) | x ← xs ]