Moved wikiHandler function from gitit.hs to Network.Gitit.

Network/Gitit.hs

@@ -19,20 +19,79 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 {- | Functions for embedding a gitit wiki into a Happstack application.
 -}
 
-module Network.Gitit ( initializeAppState 
+module Network.Gitit ( initializeAppState
                      , readMimeTypesFile
-                     , mimeTypes
                      , Config(..)
                      , User(..)
                      , Cache(..)
                      , emptyCache
-                     , queryAppState
-                     , updateAppState
                      , loadPlugin
-                     , module Network.Gitit.Handlers
+                     , wikiHandler
                      )
 where
 import Network.Gitit.Types
+import Network.Gitit.Framework
 import Network.Gitit.State
+import Network.Gitit.Server
 import Network.Gitit.Plugins (loadPlugin)
 import Network.Gitit.Handlers
+import Control.Monad.Reader
+
+-- TODO: parameterize on getLoggedInUser
+wikiHandler :: Config -> ServerPart Response
+wikiHandler conf = do
+  let staticHandler = dir "_static" $
+                      withExpiresHeaders $ fileServe [] $ staticDir conf
+  let handlers = [ debugHandler | debugMode conf] ++
+                 case authenticationMethod conf of
+                     FormAuth -> authHandler : wikiHandlers
+                     _        -> wikiHandlers
+  -- TODO - rearrange so handleAny doesn't get compressed
+  staticHandler `mplus` (mapServerPartT (unpackReaderT conf) $
+                        if compressResponses conf
+                           then compressedResponseFilter >> msum handlers
+                           else msum handlers)
+
+wikiHandlers :: [Handler]
+wikiHandlers =
+  [ dir "_activity" showActivity
+  , dir "_go"       goToPage
+  , dir "_search"   searchResults
+  , dir "_upload"   $ methodOnly GET  >> ifLoggedIn uploadForm loginUserForm
+  , dir "_upload"   $ methodOnly POST >> ifLoggedIn uploadFile loginUserForm
+  , dir "_random"   $ methodOnly GET  >> randomPage
+  , dir "_index"    indexPage
+  , guardCommand "showraw" >> msum
+      [ showRawPage
+      , guardPath isSourceCode >> showFileAsText ]
+  , guardCommand "history" >> msum
+      [ showPageHistory
+      , guardPath isSourceCode >> showFileHistory ]
+  , guardCommand "edit" >>
+      (unlessNoEdit (ifLoggedIn editPage loginUserForm) showPage)
+  , guardCommand "diff" >> msum
+      [ showPageDiff
+      , guardPath isSourceCode >> showFileDiff ]
+  , guardCommand "export"  >> exportPage
+  , guardCommand "cancel"  >> showPage
+  , guardCommand "discuss" >> discussPage
+  , guardCommand "update"  >> methodOnly POST >>
+      unlessNoEdit (ifLoggedIn updatePage loginUserForm) showPage
+  , guardCommand "delete"  >> msum
+      [ methodOnly GET  >>
+          unlessNoDelete (ifLoggedIn confirmDelete loginUserForm) showPage
+      , methodOnly POST >>
+          unlessNoDelete (ifLoggedIn deletePage loginUserForm) showPage ]
+  , guardIndex >> indexPage
+  , guardPath isPreview >> preview
+  , showPage
+  , guardPath isSourceCode >> showHighlightedSource
+  , handleAny
+  , createPage
+  ]
+
+unpackReaderT:: (Monad m)
+    => c 
+    -> (ReaderT c m) (Maybe ((Either Response a), FilterFun Response))
+    -> m (Maybe ((Either Response a), FilterFun Response))
+unpackReaderT st handler = runReaderT handler st

Network/Gitit/Handlers.hs

@@ -20,7 +20,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 {- Handlers for wiki functions.
 -}
 
-module Network.Gitit.Handlers ( handleAny
+module Network.Gitit.Handlers (
+                        handleAny
                       , debugHandler
                       , randomPage
                       , discussPage

Network/Gitit/State.hs

@@ -37,6 +37,7 @@ import Data.Ord (comparing)
 import Text.XHtml (Html, renderHtmlFragment, primHtml)
 import System.Log.Logger (Priority(..), logM)
 import Network.Gitit.Types
+import Network.Gitit.Server (mimeTypes)
 
 appstate :: IORef AppState
 appstate = unsafePerformIO $  newIORef  AppState { sessions = undefined
@@ -48,14 +49,15 @@ appstate = unsafePerformIO $  newIORef  AppState { sessions = undefined
 initializeAppState :: MonadIO m
                    => Config
                    -> M.Map String User
+                   -> [Plugin]
                    -> m ()
-initializeAppState conf users' = do
+initializeAppState conf users' plugins' = do
   mimeMapFromFile <- liftIO $ readMimeTypesFile (mimeTypesFile conf)
   updateAppState $ \s -> s { sessions  = Sessions M.empty
                            , users     = users'
                            , mimeMap   = mimeMapFromFile
                            , cache     = emptyCache
-                           , plugins   = [] }
+                           , plugins   = plugins' }
 
 -- | Read a file associating mime types with extensions, and return a
 -- map from extensions to types. Each line of the file consists of a
@@ -72,6 +74,7 @@ readMimeTypesFile f = catch
                f ++ "\n" ++ show e ++ "\n" ++ "Using defaults instead."
              return mimeTypes
 
+{-
 -- | Ready collection of common mime types. (Copied from
 -- Happstack.Server.HTTP.FileServe.)
 mimeTypes :: M.Map String String
@@ -95,6 +98,7 @@ mimeTypes = M.fromList
         ,("rtf","application/rtf")
         ,("wav","application/x-wav")
         ,("hs","text/plain")]
+-}
 
 updateAppState :: MonadIO m => (AppState -> AppState) -> m ()
 updateAppState fn = liftIO $! atomicModifyIORef appstate $ \st -> (fn st, ())

gitit.hs

@@ -19,17 +19,13 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 module Main where
 
-import Network.Gitit.Plugins ( loadPlugin )
-import Network.Gitit.Types
+import Network.Gitit
 import Network.Gitit.Server
 import Network.Gitit.Initialize (createStaticIfMissing, createRepoIfMissing)
-import Network.Gitit.Framework
-import Network.Gitit.Handlers
 import Prelude hiding (writeFile, readFile, catch)
 import System.Directory
 import System.FilePath ((</>))
 import Control.Concurrent
-import Network.Gitit.State
 import Network.Gitit.Config (getConfigFromOpts)
 import Data.Maybe (isNothing)
 import qualified Data.Map as M
@@ -74,83 +70,27 @@ main = do
        then "Found jsMath scripts -- using jsMath"
        else "Did not find jsMath scripts -- not using jsMath"
 
+  let conf' = conf{jsMath = jsMathExists, logLevel = level}  
+
+  -- load plugins
+  let loadPluginAndLog plg = logM "gitit" WARNING ("Loading plugin '" ++ plg ++ "'...") >> loadPlugin plg
+  plugins' <- mapM loadPluginAndLog (pluginModules conf')
+  unless (null $ pluginModules conf') $ logM "gitit" WARNING "Finished loading plugins."
+
   -- initialize state
-  initializeAppState conf{jsMath = jsMathExists, logLevel = level} users'
+  initializeAppState conf' users' plugins'
 
   -- setup the page repository and static files, if they don't exist
-  createRepoIfMissing conf
-  let staticdir = staticDir conf
+  createRepoIfMissing conf'
+  let staticdir = staticDir conf'
   createStaticIfMissing staticdir
 
-  -- load plugins
-  let loadPluginAndLog plg = logM "gitit" WARNING ("Loading plugin '" ++ plg ++ "'...") >> loadPlugin plg
-  plugins' <- mapM loadPluginAndLog (pluginModules conf)
-  updateAppState $ \s -> s{ plugins = plugins' }
-  unless (null $ pluginModules conf) $ logM "gitit" WARNING "Finished loading plugins."
-
-  let serverConf = Conf { validator = Nothing, port = portNumber conf }
-  let staticHandler = dir "_static" $
-                      withExpiresHeaders $ fileServe [] staticdir
-
-  let handlers = [ debugHandler | debugMode conf] ++
-                 case authenticationMethod conf of
-                    FormAuth -> authHandler : wikiHandlers
-                    _        -> wikiHandlers
-  -- TODO - rearrange so handleAny doesn't get compressed
-  let wikiHandler = mapServerPartT (unpackReaderT conf) $
-                    if compressResponses conf
-                       then compressedResponseFilter >> msum handlers
-                       else msum handlers
-
+  let serverConf = Conf { validator = Nothing, port = portNumber conf' }
   -- start the server
-  tid <- forkIO $ simpleHTTP serverConf $ msum $
-         [staticHandler, wikiHandler]
+  tid <- forkIO $ simpleHTTP serverConf $ wikiHandler conf'
   waitForTermination
 
   -- shut down the server
   killThread tid
 
-wikiHandlers :: [Handler]
-wikiHandlers =
-  [ dir "_activity" showActivity
-  , dir "_go"       goToPage
-  , dir "_search"   searchResults
-  , dir "_upload"   $ methodOnly GET  >> ifLoggedIn uploadForm loginUserForm
-  , dir "_upload"   $ methodOnly POST >> ifLoggedIn uploadFile loginUserForm
-  , dir "_random"   $ methodOnly GET  >> randomPage
-  , dir "_index"    indexPage
-  , guardCommand "showraw" >> msum
-      [ showRawPage
-      , guardPath isSourceCode >> showFileAsText ]
-  , guardCommand "history" >> msum
-      [ showPageHistory
-      , guardPath isSourceCode >> showFileHistory ]
-  , guardCommand "edit" >>
-      (unlessNoEdit (ifLoggedIn editPage loginUserForm) showPage)
-  , guardCommand "diff" >> msum
-      [ showPageDiff
-      , guardPath isSourceCode >> showFileDiff ]
-  , guardCommand "export"  >> exportPage
-  , guardCommand "cancel"  >> showPage
-  , guardCommand "discuss" >> discussPage
-  , guardCommand "update"  >> methodOnly POST >>
-      unlessNoEdit (ifLoggedIn updatePage loginUserForm) showPage
-  , guardCommand "delete"  >> msum
-      [ methodOnly GET  >>
-          unlessNoDelete (ifLoggedIn confirmDelete loginUserForm) showPage
-      , methodOnly POST >>
-          unlessNoDelete (ifLoggedIn deletePage loginUserForm) showPage ]
-  , guardIndex >> indexPage
-  , guardPath isPreview >> preview
-  , showPage
-  , guardPath isSourceCode >> showHighlightedSource
-  , handleAny
-  , createPage
-  ]
-
-unpackReaderT:: (Monad m)
-    => c 
-    -> (ReaderT c m) (Maybe ((Either Response a), FilterFun Response))
-    -> m (Maybe ((Either Response a), FilterFun Response))
-unpackReaderT st handler = runReaderT handler st