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.Trackback as Trackback
  25 import qualified Rakka.Wiki.Interpreter.Outline   as Outline
  26 import           Subversion.Repository
  27 import           System.Directory
  28 import           System.FilePath
  29 import           System.Log.Logger
  30 import           Text.HyperEstraier
  31 import Text.XML.HXT.Arrow.XmlState
  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 setupEnv ∷ FilePath → ServiceName → IO Environment
  48 setupEnv lsdir port
  49     = do let lucuConf    = LC.defaultConfig {
  50                              LC.cnfServerPort = port
  51                            }
  52              reposPath   = lsdir </> "repos"
  53              interpTable = mkInterpTable
  54          reposExist  <- doesDirectoryExist reposPath
  55          repos       <- if reposExist then
  56                             do debugM logger ("Found a subversion repository on " ++ reposPath)
  57                                openRepository reposPath
  58                         else
  59                             do noticeM logger ("Creating a subversion repository on " ++ reposPath)
  60                                createRepository reposPath [] []
  61          sysConf     <- mkSystemConfig lucuConf repos
  62          storage     <- mkStorage lsdir repos (makeDraft' interpTable)
  63          authDB      <- mkAuthDB lsdir
  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 mkInterpTable ∷ InterpTable
  87 mkInterpTable = listToTable $
  88                 concat [ Base.interpreters
  89                        , Image.interpreters
  90                        , PageList.interpreters
  91                        --, Trackback.interpreters
  92                        , Outline.interpreters
  93                        ]
  94     where
  95       listToTable ∷ [Interpreter] → InterpTable
  96       listToTable xs
  97           = M.fromList [ (commandName x, x) | x ← xs ]