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.Page
  14 import           Rakka.Storage
  15 import           Rakka.SystemConfig
  16 import           Rakka.Wiki.Engine
  17 import           Rakka.Wiki.Interpreter
  18 import qualified Rakka.Wiki.Interpreter.Base      as Base
  19 import qualified Rakka.Wiki.Interpreter.Image     as Image
  20 import qualified Rakka.Wiki.Interpreter.PageList  as PageList
  21 import qualified Rakka.Wiki.Interpreter.Trackback as Trackback
  22 import qualified Rakka.Wiki.Interpreter.Outline   as Outline
  23 import           Subversion.Repository
  24 import           System.Directory
  25 import           System.FilePath
  26 import           System.IO
  27 import           System.Log.Logger
  28 import           Text.HyperEstraier
  29 import           Text.XML.HXT.Arrow.XmlIOStateArrow
  30
  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     }
  44
  45
  46 setupEnv :: FilePath -> PortNumber -> IO Environment
  47 setupEnv lsdir portNum
  48     = do let lucuConf    = LC.defaultConfig {
  49                              LC.cnfServerPort = PortNumber portNum
  50                            }
  51              reposPath   = lsdir </> "repos"
  52              interpTable = mkInterpTable
  53
  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
  64          return $ Environment {
  65                       envLocalStateDir = lsdir
  66                     , envLucuConf      = lucuConf
  67                     , envRepository    = repos
  68                     , envSysConf       = sysConf
  69                     , envStorage       = storage
  70                     , envInterpTable   = interpTable
  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
  86 mkInterpTable :: InterpTable
  87 mkInterpTable = listToTable $
  88                 foldl (++) [] [ 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 ]