Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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

  • Loading branch information...
commit 24695bf6ffd18034b29e5ef49b44c4fbbbd43fdb 1 parent 3da0cc8
@jgm authored
View
69 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
View
3  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
View
8 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, ())
View
86 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
Please sign in to comment.
Something went wrong with that request. Please try again.