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