1 module Rakka.Environment
9 import Control.Arrow.ArrowList
10 import qualified Data.Map as M
12 import qualified Network.HTTP.Lucu.Config as LC
13 import Rakka.Authorization
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
31 logger = "Rakka.Environment"
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
45 setupEnv :: FilePath -> ServiceName -> IO Environment
46 setupEnv lsdir portNum
47 = do let lucuConf = LC.defaultConfig {
48 LC.cnfServerPort = portNum
50 reposPath = lsdir </> "repos"
51 interpTable = mkInterpTable
53 reposExist <- doesDirectoryExist reposPath
54 repos <- if reposExist then
55 do debugM logger ("Found a subversion repository on " ++ reposPath)
56 openRepository reposPath
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
65 envLocalStateDir = lsdir
66 , envLucuConf = lucuConf
67 , envRepository = repos
68 , envSysConf = sysConf
69 , envStorage = storage
70 , envInterpTable = interpTable
74 makeDraft' :: InterpTable -> Page -> IO Document
75 makeDraft' interpTable page
76 = do [doc] <- runX ( setErrorMsgHandler False fail
87 mkInterpTable :: InterpTable
88 mkInterpTable = listToTable $
89 foldl (++) [] [ Base.interpreters
91 , PageList.interpreters
92 --, Trackback.interpreters
93 , Outline.interpreters
96 listToTable :: [Interpreter] -> InterpTable
98 = M.fromList [ (commandName x, x) | x <- xs ]