+{-# LANGUAGE
+ UnicodeSyntax
+ #-}
module Rakka.Environment
( Environment(..)
, InterpTable
, setupEnv
- , getInterpTable
- , getInterpTableA
)
where
-
-import Control.Concurrent.STM
-import Control.Arrow.ArrowIO
-import Data.Map (Map)
+import Control.Arrow.ArrowList
+import Control.Arrow.Unicode
import qualified Data.Map as M
-import Network
+import Network.Socket
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 Rakka.Wiki.Interpreter.Base
+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.Outline as Outline
import Subversion.Repository
import System.Directory
import System.FilePath
+import System.Log.Logger
+import Text.HyperEstraier
+import Text.XML.HXT.Arrow.XmlState
+
+logger :: String
+logger = "Rakka.Environment"
data Environment = Environment {
envLocalStateDir :: !FilePath
, envLucuConf :: !LC.Config
, envRepository :: !Repository
- , envStorage :: !Storage
, envSysConf :: !SystemConfig
- , envInterpTable :: !(TVar InterpTable)
+ , envStorage :: !Storage
+ , envInterpTable :: !InterpTable
+ , envAuthDB :: !AuthDB
}
-
-type InterpTable = Map String Interpreter
-
-
-setupEnv :: FilePath -> PortNumber -> IO Environment
-setupEnv lsdir portNum
- = do let lucuConf = LC.defaultConfig {
- LC.cnfServerPort = PortNumber portNum
- }
- reposPath = lsdir `combine` "repos"
- storage = mkStorage
-
+setupEnv ∷ FilePath → ServiceName → IO Environment
+setupEnv lsdir port
+ = do let lucuConf = LC.defaultConfig {
+ LC.cnfServerPort = port
+ }
+ reposPath = lsdir </> "repos"
+ interpTable = mkInterpTable
reposExist <- doesDirectoryExist reposPath
repos <- if reposExist then
- openRepository reposPath
+ do debugM logger ("Found a subversion repository on " ++ reposPath)
+ openRepository reposPath
else
- createRepository reposPath [] []
+ do noticeM logger ("Creating a subversion repository on " ++ reposPath)
+ createRepository reposPath [] []
sysConf <- mkSystemConfig lucuConf repos
- interpTable <- mkInterpTable
-
- return $ Environment {
+ storage <- mkStorage lsdir repos (makeDraft' interpTable)
+ authDB <- mkAuthDB lsdir
+ return Environment {
envLocalStateDir = lsdir
, envLucuConf = lucuConf
, envRepository = repos
- , envStorage = storage
, envSysConf = sysConf
+ , envStorage = storage
, 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 :: IO (TVar InterpTable)
-mkInterpTable = newTVarIO (listToTable baseInterpreters)
+mkInterpTable ∷ InterpTable
+mkInterpTable = listToTable $
+ concat [ Base.interpreters
+ , Image.interpreters
+ , PageList.interpreters
+ , Outline.interpreters
+ ]
where
- listToTable :: [Interpreter] -> InterpTable
+ listToTable ∷ [Interpreter] → InterpTable
listToTable xs
- = M.fromList [ (commandName x, x) | x <- xs ]
-
-
-getInterpTable :: Environment -> IO InterpTable
-getInterpTable = atomically . readTVar . envInterpTable
-
-
-getInterpTableA :: ArrowIO a => Environment -> a b InterpTable
-getInterpTableA = arrIO0 . getInterpTable
+ = M.fromList [ (commandName x, x) | x ← xs ]