merge branch origin/master

[Rakka.git] / Rakka / Environment.hs

diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs
index 367b67365b896d03a2053bcf4ec20ce6f7ce9ca4..2de28b2ce2bf8df28106d664b0bd4abde30f742e 100644 (file)
--- a/Rakka/Environment.hs
+++ b/Rakka/Environment.hs
@@ -1,14 +1,16 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}

 module Rakka.Environment
     ( Environment(..)
     , InterpTable
     , setupEnv
     )
     where
 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 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 qualified Network.HTTP.Lucu.Config as LC
 import           Rakka.Authorization
 import           Rakka.Page


@@ -19,16 +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.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 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           System.Log.Logger
 import           Text.HyperEstraier

-import           Text.XML.HXT.Arrow.XmlIOStateArrow
-
+import Text.XML.HXT.Arrow.XmlState

 
 logger :: String
 logger = "Rakka.Environment"
 
 logger :: String
 logger = "Rakka.Environment"


@@ -44,15 +43,13 @@ data Environment = Environment {
     , envAuthDB        :: !AuthDB
     }
 
     , envAuthDB        :: !AuthDB
     }
 

-
-setupEnv :: FilePath -> PortNumber -> IO Environment
-setupEnv lsdir portNum
+setupEnv ∷ FilePath → ServiceName → IO Environment
+setupEnv lsdir port

     = do let lucuConf    = LC.defaultConfig {
     = do let lucuConf    = LC.defaultConfig {

-                             LC.cnfServerPort = PortNumber portNum
+                             LC.cnfServerPort = port

                            }
              reposPath   = lsdir </> "repos"
              interpTable = mkInterpTable
                            }
              reposPath   = lsdir </> "repos"
              interpTable = mkInterpTable

-         

          reposExist  <- doesDirectoryExist reposPath
          repos       <- if reposExist then
                             do debugM logger ("Found a subversion repository on " ++ reposPath)
          reposExist  <- doesDirectoryExist reposPath
          repos       <- if reposExist then
                             do debugM logger ("Found a subversion repository on " ++ reposPath)


@@ -63,8 +60,7 @@ setupEnv lsdir portNum
          sysConf     <- mkSystemConfig lucuConf repos
          storage     <- mkStorage lsdir repos (makeDraft' interpTable)
          authDB      <- mkAuthDB lsdir
          sysConf     <- mkSystemConfig lucuConf repos
          storage     <- mkStorage lsdir repos (makeDraft' interpTable)
          authDB      <- mkAuthDB lsdir

-
-         return $ Environment {
+         return Environment {

                       envLocalStateDir = lsdir
                     , envLucuConf      = lucuConf
                     , envRepository    = repos
                       envLocalStateDir = lsdir
                     , envLucuConf      = lucuConf
                     , envRepository    = repos


@@ -74,28 +70,26 @@ setupEnv lsdir portNum
                     , envAuthDB        = authDB
                     }
     where
                     , envAuthDB        = authDB
                     }
     where

-      makeDraft' :: InterpTable -> Page -> IO Document
+      makeDraft' ∷ InterpTable → Page → IO Document

       makeDraft' interpTable page
       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
 
                return doc
 

-
-mkInterpTable :: InterpTable
+mkInterpTable ∷ InterpTable

 mkInterpTable = listToTable $
 mkInterpTable = listToTable $

-                foldl (++) [] [ Base.interpreters
-                              , Image.interpreters
-                              , PageList.interpreters
-                              , Trackback.interpreters
-                              , Outline.interpreters
-                              ]
+                concat [ Base.interpreters
+                       , Image.interpreters
+                       , PageList.interpreters
+                       , Outline.interpreters
+                       ]

     where
     where

-      listToTable :: [Interpreter] -> InterpTable
+      listToTable ∷ [Interpreter] → InterpTable

       listToTable xs
       listToTable xs

-          = M.fromList [ (commandName x, x) | x <- xs ]
+          = M.fromList [ (commandName x, x) | x ← xs ]