The big change

[Rakka.git] / Rakka / Environment.hs

diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs
index f8d824b9516b2a94108d10351cb5739de7f05f1f..d40294ae44c27f224908291509c3f735478c40e6 100644 (file)
--- a/Rakka/Environment.hs
+++ b/Rakka/Environment.hs
@@ -5,15 +5,19 @@ module Rakka.Environment
     )
     where
 
     )
     where
 

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

 import qualified Data.Map as M
 import           Network
 import qualified Network.HTTP.Lucu.Config as LC
 import qualified Data.Map as M
 import           Network
 import qualified Network.HTTP.Lucu.Config as LC

+import           Rakka.Page

 import           Rakka.Storage
 import           Rakka.SystemConfig
 import           Rakka.Wiki.Engine
 import           Rakka.Wiki.Interpreter
 import qualified Rakka.Wiki.Interpreter.Base      as Base
 import qualified Rakka.Wiki.Interpreter.Image     as Image
 import           Rakka.Storage
 import           Rakka.SystemConfig
 import           Rakka.Wiki.Engine
 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 qualified Rakka.Wiki.Interpreter.Trackback as Trackback
 import qualified Rakka.Wiki.Interpreter.Outline   as Outline
 import           Subversion.Repository


@@ -21,6 +25,8 @@ import           System.Directory
 import           System.FilePath
 import           System.IO
 import           System.Log.Logger
 import           System.FilePath
 import           System.IO
 import           System.Log.Logger

+import           Text.HyperEstraier
+import           Text.XML.HXT.Arrow.XmlIOStateArrow

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


@@ -41,7 +47,7 @@ setupEnv lsdir portNum
     = do let lucuConf    = LC.defaultConfig {
                              LC.cnfServerPort = PortNumber portNum
                            }
     = do let lucuConf    = LC.defaultConfig {
                              LC.cnfServerPort = PortNumber portNum
                            }

-             reposPath   = lsdir `combine` "repos"
+             reposPath   = lsdir </> "repos"

              interpTable = mkInterpTable
          
          reposExist  <- doesDirectoryExist reposPath
              interpTable = mkInterpTable
          
          reposExist  <- doesDirectoryExist reposPath


@@ -52,7 +58,7 @@ 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)

 
          return $ Environment {
                       envLocalStateDir = lsdir
 
          return $ Environment {
                       envLocalStateDir = lsdir


@@ -62,12 +68,25 @@ setupEnv lsdir portNum
                     , envStorage       = storage
                     , envInterpTable   = interpTable
                     }
                     , envStorage       = storage
                     , envInterpTable   = interpTable
                     }

+    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 = listToTable $
                 foldl (++) [] [ Base.interpreters
                               , Image.interpreters
 
 
 mkInterpTable :: InterpTable
 mkInterpTable = listToTable $
                 foldl (++) [] [ Base.interpreters
                               , Image.interpreters

+                              , PageList.interpreters

                               , Trackback.interpreters
                               , Outline.interpreters
                               ]
                               , Trackback.interpreters
                               , Outline.interpreters
                               ]