Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Began moving general framework functions to Gitit.Framework.

  • Loading branch information...
commit 56e7c5394bf6e0dd4e8ac5ab8a69b4299f342497 1 parent 4bca52b
@jgm authored
Showing with 68 additions and 32 deletions.
  1. +1 −31 Gitit.hs
  2. +65 −0 Gitit/Framework.hs
  3. +2 −1  gitit.cabal
View
32 Gitit.hs
@@ -23,6 +23,7 @@ import HAppS.Server hiding (look, lookRead, lookCookieValue, mkCookie)
import Gitit.HAppS (look, lookRead, lookCookieValue, mkCookie, cookieFixer)
import Gitit.Util (withTempDir, orIfNull, consolidateHeads)
import Gitit.Initialize (createStaticIfMissing, createRepoIfMissing)
+import Gitit.Framework (Handler, filterIf, gzipBinary, acceptsZip, withExpiresHeaders, setContentType, setFilename)
import System.IO.UTF8
import System.IO (stderr)
import Control.Exception (throwIO, catch, try)
@@ -49,7 +50,6 @@ import Text.Pandoc.Shared (HTMLMathMethod(..), substitute)
import Data.Char (isAlphaNum, isAlpha, toLower)
import Control.Monad.Reader
import qualified Data.ByteString.Lazy as B
-import Codec.Compression.GZip (compress)
import Network.HTTP (urlEncodeVars, urlEncode)
import Text.Highlighting.Kate
import qualified Text.StringTemplate as T
@@ -113,36 +113,6 @@ main = do
putStrLn "Shutdown complete"
-filterIf :: (Request -> Bool) -> (Response -> Response) -> ServerPart Response -> ServerPart Response
-filterIf test filt sp =
- let handler = unServerPartT sp
- in withRequest $ \req ->
- if test req
- then liftM filt $ handler req
- else handler req
-
-gzipBinary :: Response -> Response
-gzipBinary r@(Response {rsBody = b}) = setHeader "Content-Encoding" "gzip" $ r {rsBody = compress b}
-
-acceptsZip :: Request -> Bool
-acceptsZip req = isJust $ M.lookup (fromString "accept-encoding") (rqHeaders req)
-
-getCacheTime :: IO (Maybe DateTime)
-getCacheTime = liftM (Just . addMinutes 360) $ getCurrentTime
-
-withExpiresHeaders :: ServerPart Response -> ServerPart Response
-withExpiresHeaders sp = require getCacheTime $ \t -> [liftM (setHeader "Expires" $ formatDateTime "%a, %d %b %Y %T GMT" t) sp]
-
-setContentType :: String -> Response -> Response
-setContentType = setHeader "Content-Type"
-
-setFilename :: String -> Response -> Response
-setFilename = setHeader "Content-Disposition" . \fname -> "attachment: filename=\"" ++ fname ++ "\""
-
-
-
-type Handler = ServerPart Response
-
debugHandler :: Handler
debugHandler = do
View
65 Gitit/Framework.hs
@@ -0,0 +1,65 @@
+{-
+Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- General framework for defining wiki actions.
+-}
+
+module Gitit.Framework (
+ Handler
+ , filterIf
+ , gzipBinary
+ , acceptsZip
+ , withExpiresHeaders
+ , setContentType
+ , setFilename
+ )
+where
+import HAppS.Server hiding (look, lookRead, lookCookieValue, mkCookie)
+import Data.DateTime
+import Control.Monad (liftM)
+import qualified Data.Map as M
+import Codec.Compression.GZip (compress)
+import Data.ByteString.UTF8 (fromString)
+import Data.Maybe (isJust)
+
+type Handler = ServerPart Response
+
+filterIf :: (Request -> Bool) -> (Response -> Response) -> ServerPart Response -> ServerPart Response
+filterIf test filt sp =
+ let handler = unServerPartT sp
+ in withRequest $ \req ->
+ if test req
+ then liftM filt $ handler req
+ else handler req
+
+gzipBinary :: Response -> Response
+gzipBinary r@(Response {rsBody = b}) = setHeader "Content-Encoding" "gzip" $ r {rsBody = compress b}
+
+acceptsZip :: Request -> Bool
+acceptsZip req = isJust $ M.lookup (fromString "accept-encoding") (rqHeaders req)
+
+getCacheTime :: IO (Maybe DateTime)
+getCacheTime = liftM (Just . addMinutes 360) $ getCurrentTime
+
+withExpiresHeaders :: ServerPart Response -> ServerPart Response
+withExpiresHeaders sp = require getCacheTime $ \t -> [liftM (setHeader "Expires" $ formatDateTime "%a, %d %b %Y %T GMT" t) sp]
+
+setContentType :: String -> Response -> Response
+setContentType = setHeader "Content-Type"
+
+setFilename :: String -> Response -> Response
+setFilename = setHeader "Content-Disposition" . \fname -> "attachment: filename=\"" ++ fname ++ "\""
+
+
View
3  gitit.cabal
@@ -43,7 +43,8 @@ Executable gitit
hs-source-dirs: .
main-is: Gitit.hs
other-modules: Gitit.State, Gitit.HAppS, Gitit.MimeTypes, Gitit.Util,
- Gitit.Initialize, Gitit.Config, Paths_gitit
+ Gitit.Initialize, Gitit.Config, Gitit.Framework,
+ Paths_gitit
build-depends: base >=3, parsec < 3, pretty, xhtml, containers, pandoc
>= 1.1, process, filepath, directory, mtl, cgi,
network, old-time, highlighting-kate, bytestring,
Please sign in to comment.
Something went wrong with that request. Please try again.