X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=2de28b2ce2bf8df28106d664b0bd4abde30f742e;hp=8d3c16c04fec4e430a286ff91643b579ec7b8341;hb=HEAD;hpb=223d4df57fa1371945075d4d2714e5f36c1fc5dd diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 8d3c16c..2de28b2 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -1,14 +1,16 @@ +{-# 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 @@ -19,15 +21,13 @@ 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.Log.Logger import Text.HyperEstraier -import Text.XML.HXT.Arrow.XmlIOStateArrow - +import Text.XML.HXT.Arrow.XmlState logger :: String logger = "Rakka.Environment" @@ -43,15 +43,13 @@ data Environment = 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) @@ -62,7 +60,6 @@ setupEnv lsdir portNum sysConf <- mkSystemConfig lucuConf repos storage <- mkStorage lsdir repos (makeDraft' interpTable) authDB <- mkAuthDB lsdir - return Environment { envLocalStateDir = lsdir , envLucuConf = lucuConf @@ -73,28 +70,26 @@ setupEnv lsdir portNum , 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 ]