X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FEnvironment.hs;h=2de28b2ce2bf8df28106d664b0bd4abde30f742e;hb=HEAD;hp=9a6df3a396fd3276156178227adcfcc22bab926f;hpb=9932fbe6504e8b812703291e2497a5f010880d3b;p=Rakka.git diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 9a6df3a..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 @@ -25,7 +27,7 @@ import System.Directory import System.FilePath import System.Log.Logger import Text.HyperEstraier - +import Text.XML.HXT.Arrow.XmlState logger :: String logger = "Rakka.Environment" @@ -41,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) @@ -60,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 @@ -71,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 ]