+{-# LANGUAGE
+ UnicodeSyntax
+ #-}
module Rakka.Environment
( Environment(..)
, InterpTable
, setupEnv
)
where
-
-import Control.Arrow
-import Control.Arrow.ArrowList
+import Control.Arrow.ArrowList
+import Control.Arrow.Unicode
import qualified Data.Map as M
-import Network.Socket
+import Network.Socket
import qualified Network.HTTP.Lucu.Config as LC
import Rakka.Authorization
import Rakka.Page
import System.FilePath
import System.Log.Logger
import Text.HyperEstraier
-
+import Text.XML.HXT.Arrow.XmlState
logger :: String
logger = "Rakka.Environment"
, envAuthDB :: !AuthDB
}
-
-setupEnv :: FilePath -> ServiceName -> IO Environment
-setupEnv lsdir portNum
+setupEnv ∷ FilePath → ServiceName → IO Environment
+setupEnv lsdir port
= do let lucuConf = LC.defaultConfig {
- LC.cnfServerPort = portNum
+ LC.cnfServerPort = port
}
reposPath = lsdir </> "repos"
interpTable = mkInterpTable
-
reposExist <- doesDirectoryExist reposPath
repos <- if reposExist then
do debugM logger ("Found a subversion repository on " ++ reposPath)
sysConf <- mkSystemConfig lucuConf repos
storage <- mkStorage lsdir repos (makeDraft' interpTable)
authDB <- mkAuthDB lsdir
-
return Environment {
envLocalStateDir = lsdir
, envLucuConf = lucuConf
, envAuthDB = authDB
}
where
- makeDraft' :: InterpTable -> Page -> IO Document
+ makeDraft' ∷ InterpTable → Page → IO Document
makeDraft' interpTable page
- = do [doc] <- runX ( setErrorMsgHandler False fail
- >>>
- constA page
- >>>
- xmlizePage
- >>>
- makeDraft interpTable
- )
+ = do [doc] ← runX ( setErrorMsgHandler False fail
+ ⋙
+ constA page
+ ⋙
+ xmlizePage
+ ⋙
+ makeDraft interpTable
+ )
return doc
-
-mkInterpTable :: InterpTable
+mkInterpTable ∷ InterpTable
mkInterpTable = listToTable $
- foldl (++) [] [ Base.interpreters
- , Image.interpreters
- , PageList.interpreters
- --, Trackback.interpreters
- , Outline.interpreters
- ]
+ 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 ]
+ = M.fromList [ (commandName x, x) | x ← xs ]