]> gitweb @ CieloNegro.org - Rakka.git/blob - Rakka/Environment.hs
8d3c16c04fec4e430a286ff91643b579ec7b8341
[Rakka.git] / 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.Socket
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.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     , envAuthDB        :: !AuthDB
44     }
45
46
47 setupEnv :: FilePath -> ServiceName -> IO Environment
48 setupEnv lsdir portNum
49     = do let lucuConf    = LC.defaultConfig {
50                              LC.cnfServerPort = portNum
51                            }
52              reposPath   = lsdir </> "repos"
53              interpTable = mkInterpTable
54          
55          reposExist  <- doesDirectoryExist reposPath
56          repos       <- if reposExist then
57                             do debugM logger ("Found a subversion repository on " ++ reposPath)
58                                openRepository reposPath
59                         else
60                             do noticeM logger ("Creating a subversion repository on " ++ reposPath)
61                                createRepository reposPath [] []
62          sysConf     <- mkSystemConfig lucuConf repos
63          storage     <- mkStorage lsdir repos (makeDraft' interpTable)
64          authDB      <- mkAuthDB lsdir
65
66          return Environment {
67                       envLocalStateDir = lsdir
68                     , envLucuConf      = lucuConf
69                     , envRepository    = repos
70                     , envSysConf       = sysConf
71                     , envStorage       = storage
72                     , envInterpTable   = interpTable
73                     , envAuthDB        = authDB
74                     }
75     where
76       makeDraft' :: InterpTable -> Page -> IO Document
77       makeDraft' interpTable page
78           = do [doc] <- runX ( setErrorMsgHandler False fail
79                                >>>
80                                constA page
81                                >>>
82                                xmlizePage
83                                >>>
84                                makeDraft interpTable
85                              )
86                return doc
87
88
89 mkInterpTable :: InterpTable
90 mkInterpTable = listToTable $
91                 foldl (++) [] [ Base.interpreters
92                               , Image.interpreters
93                               , PageList.interpreters
94                               --, Trackback.interpreters
95                               , Outline.interpreters
96                               ]
97     where
98       listToTable :: [Interpreter] -> InterpTable
99       listToTable xs
100           = M.fromList [ (commandName x, x) | x <- xs ]