Fixing build breakage...

[Rakka.git] / Rakka / Environment.hs

diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs
index 321ba7ed07bac0a8ba53304ac1a798f8c84c1901..9a6df3a396fd3276156178227adcfcc22bab926f 100644 (file)
--- a/Rakka/Environment.hs
+++ b/Rakka/Environment.hs
@@ -5,9 +5,13 @@ module Rakka.Environment
     )
     where
 
     )
     where
 

+import           Control.Arrow
+import           Control.Arrow.ArrowList

 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 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.Storage
 import           Rakka.SystemConfig
 import           Rakka.Wiki.Engine


@@ -15,15 +19,15 @@ 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           System.Log.Logger

+import           Text.HyperEstraier

 
 
 
 

+logger :: String

 logger = "Rakka.Environment"
 
 
 logger = "Rakka.Environment"
 
 


@@ -34,13 +38,14 @@ data Environment = Environment {
     , envSysConf       :: !SystemConfig
     , envStorage       :: !Storage
     , envInterpTable   :: !InterpTable
     , envSysConf       :: !SystemConfig
     , envStorage       :: !Storage
     , envInterpTable   :: !InterpTable

+    , envAuthDB        :: !AuthDB

     }
 
 
     }
 
 

-setupEnv :: FilePath -> PortNumber -> IO Environment
+setupEnv :: FilePath -> ServiceName -> IO Environment

 setupEnv lsdir portNum
     = do let lucuConf    = LC.defaultConfig {
 setupEnv lsdir portNum
     = do let lucuConf    = LC.defaultConfig {

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

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


@@ -53,16 +58,30 @@ setupEnv lsdir portNum
                             do noticeM logger ("Creating a subversion repository on " ++ reposPath)
                                createRepository reposPath [] []
          sysConf     <- mkSystemConfig lucuConf repos
                             do noticeM logger ("Creating a subversion repository on " ++ reposPath)
                                createRepository reposPath [] []
          sysConf     <- mkSystemConfig lucuConf repos

-         storage     <- mkStorage lsdir repos (makeDraft interpTable)
+         storage     <- mkStorage lsdir repos (makeDraft' interpTable)
+         authDB      <- mkAuthDB lsdir

 
 

-         return $ Environment {
+         return Environment {

                       envLocalStateDir = lsdir
                     , envLucuConf      = lucuConf
                     , envRepository    = repos
                     , envSysConf       = sysConf
                     , envStorage       = storage
                     , envInterpTable   = interpTable
                       envLocalStateDir = lsdir
                     , envLucuConf      = lucuConf
                     , envRepository    = repos
                     , 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 :: InterpTable
 
 
 mkInterpTable :: InterpTable


@@ -70,7 +89,7 @@ mkInterpTable = listToTable $
                 foldl (++) [] [ Base.interpreters
                               , Image.interpreters
                               , PageList.interpreters
                 foldl (++) [] [ Base.interpreters
                               , Image.interpreters
                               , PageList.interpreters

-                              , Trackback.interpreters
+                              --, Trackback.interpreters

                               , Outline.interpreters
                               ]
     where
                               , Outline.interpreters
                               ]
     where