module Rakka.Environment
( Environment(..)
+ , InterpTable
, setupEnv
)
where
+import Control.Arrow
+import Control.Arrow.ArrowList
+import qualified Data.Map as M
import Network
import qualified Network.HTTP.Lucu.Config as LC
+import Rakka.Authorization
+import Rakka.Page
import Rakka.Storage
+import Rakka.SystemConfig
+import Rakka.Wiki.Engine
+import Rakka.Wiki.Interpreter
+import qualified Rakka.Wiki.Interpreter.Base as Base
+import qualified Rakka.Wiki.Interpreter.Image as Image
+import qualified Rakka.Wiki.Interpreter.PageList as PageList
+import qualified Rakka.Wiki.Interpreter.Trackback as Trackback
+import qualified Rakka.Wiki.Interpreter.Outline as Outline
+import Subversion.Repository
+import System.Directory
+import System.FilePath
+import System.IO
+import System.Log.Logger
+import Text.HyperEstraier
+import Text.XML.HXT.Arrow.XmlIOStateArrow
+
+
+logger :: String
+logger = "Rakka.Environment"
data Environment = Environment {
- envLocalStateDir :: FilePath
- , envLucuConf :: LC.Config
- , envStorage :: Storage
+ envLocalStateDir :: !FilePath
+ , envLucuConf :: !LC.Config
+ , envRepository :: !Repository
+ , envSysConf :: !SystemConfig
+ , envStorage :: !Storage
+ , envInterpTable :: !InterpTable
+ , envAuthDB :: !AuthDB
}
setupEnv :: FilePath -> PortNumber -> IO Environment
setupEnv lsdir portNum
- = do let lucuConf = LC.defaultConfig {
- LC.cnfServerPort = PortNumber portNum
- }
- storage <- mkStorage -- FIXME
+ = do let lucuConf = LC.defaultConfig {
+ LC.cnfServerPort = PortNumber portNum
+ }
+ reposPath = lsdir </> "repos"
+ interpTable = mkInterpTable
+
+ reposExist <- doesDirectoryExist reposPath
+ repos <- if reposExist then
+ do debugM logger ("Found a subversion repository on " ++ reposPath)
+ openRepository reposPath
+ else
+ do noticeM logger ("Creating a subversion repository on " ++ reposPath)
+ createRepository reposPath [] []
+ sysConf <- mkSystemConfig lucuConf repos
+ storage <- mkStorage lsdir repos (makeDraft' interpTable)
+ authDB <- mkAuthDB lsdir
+
return $ Environment {
envLocalStateDir = lsdir
, envLucuConf = lucuConf
+ , envRepository = repos
+ , envSysConf = sysConf
, envStorage = storage
- }
\ No newline at end of file
+ , envInterpTable = interpTable
+ , envAuthDB = authDB
+ }
+ where
+ makeDraft' :: InterpTable -> Page -> IO Document
+ makeDraft' interpTable page
+ = do [doc] <- runX ( setErrorMsgHandler False fail
+ >>>
+ constA page
+ >>>
+ xmlizePage
+ >>>
+ makeDraft interpTable
+ )
+ return doc
+
+
+mkInterpTable :: InterpTable
+mkInterpTable = listToTable $
+ foldl (++) [] [ Base.interpreters
+ , Image.interpreters
+ , PageList.interpreters
+ , Trackback.interpreters
+ , Outline.interpreters
+ ]
+ where
+ listToTable :: [Interpreter] -> InterpTable
+ listToTable xs
+ = M.fromList [ (commandName x, x) | x <- xs ]