This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-core".
The branch, master has been updated
via 0beeba44088c30faecf27537ad1089209e426a0b (commit)
via 99b33115a4c7bd3f5912caaed53a457b426c75c4 (commit)
from fd9227c957ad7ccc044f14c1e050db2e6b4a303c (commit)
Summary of changes:
src/Data/CIByteString.hs | 21 ++++++++++++-
src/Snap/Internal/Debug.hs | 4 +-
src/Snap/Internal/Http/Types.hs | 51 ++++++++++++++++--------------
src/Snap/Internal/Iteratee/Debug.hs | 3 +-
src/Snap/Internal/Routing.hs | 17 ++++++----
src/Snap/Internal/Types.hs | 58 ++++++++++++++++++-----------------
src/Snap/Iteratee.hs | 54 +++++++++++++++++++++-----------
src/Snap/Util/FileServe.hs | 15 +++++----
src/Snap/Util/GZip.hs | 9 +++--
9 files changed, 140 insertions(+), 92 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 0beeba44088c30faecf27537ad1089209e426a0b
Author: Mighty Byte <[email protected]>
Date: Sun Dec 12 18:36:19 2010 -0500
Cleaned up code style.
diff --git a/src/Data/CIByteString.hs b/src/Data/CIByteString.hs
index f80cd78..ce2b45b 100644
--- a/src/Data/CIByteString.hs
+++ b/src/Data/CIByteString.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
+------------------------------------------------------------------------------
-- | "Data.CIByteString" is a module containing 'CIByteString', a wrapper for
-- 'ByteString' which provides case-insensitive (ASCII-wise) 'Ord' and 'Eq'
-- instances.
@@ -11,7 +12,8 @@
--
-- @
-- \> let a = \"Foo\" in
--- putStrLn $ (show $ unCI a) ++ \"==\\\"FoO\\\" is \" ++ show (a == \"FoO\")
+-- putStrLn $ (show $ unCI a) ++ \"==\\\"FoO\\\" is \" ++
+-- show (a == \"FoO\")
-- \"Foo\"==\"FoO\" is True
-- @
@@ -22,6 +24,8 @@ module Data.CIByteString
, ciToLower
) where
+
+------------------------------------------------------------------------------
-- for IsString instance
import Data.ByteString.Char8 ()
import Data.ByteString (ByteString)
@@ -31,30 +35,45 @@ import Data.Char
import Data.String
+------------------------------------------------------------------------------
-- | A case-insensitive newtype wrapper for 'ByteString'
data CIByteString = CIByteString { unCI :: !ByteString
, _lowercased :: !ByteString }
+
+------------------------------------------------------------------------------
toCI :: ByteString -> CIByteString
toCI s = CIByteString s t
where
t = lowercase s
+
+------------------------------------------------------------------------------
ciToLower :: CIByteString -> ByteString
ciToLower = _lowercased
+
+------------------------------------------------------------------------------
instance Show CIByteString where
show (CIByteString s _) = show s
+
+------------------------------------------------------------------------------
lowercase :: ByteString -> ByteString
lowercase = S.map (c2w . toLower . w2c)
+
+------------------------------------------------------------------------------
instance Eq CIByteString where
(CIByteString _ a) == (CIByteString _ b) = a == b
(CIByteString _ a) /= (CIByteString _ b) = a /= b
+
+------------------------------------------------------------------------------
instance Ord CIByteString where
(CIByteString _ a) <= (CIByteString _ b) = a <= b
+
+------------------------------------------------------------------------------
instance IsString CIByteString where
fromString = toCI . fromString
diff --git a/src/Snap/Internal/Http/Types.hs b/src/Snap/Internal/Http/Types.hs
index 62ea1e8..69d72ec 100644
--- a/src/Snap/Internal/Http/Types.hs
+++ b/src/Snap/Internal/Http/Types.hs
@@ -98,8 +98,9 @@ class HasHeaders a where
------------------------------------------------------------------------------
--- | Adds a header key-value-pair to the 'HasHeaders' datatype. If a header
with
--- the same name already exists, the new value is appended to the headers list.
+-- | Adds a header key-value-pair to the 'HasHeaders' datatype. If a header
+-- with the same name already exists, the new value is appended to the headers
+-- list.
addHeader :: (HasHeaders a) => CIByteString -> ByteString -> a -> a
addHeader k v = updateHeaders $ Map.insertWith' (++) k [v]
@@ -222,11 +223,11 @@ data Request = Request
, rqCookies :: [Cookie]
- -- | We'll be doing web components (or \"snaplets\") for version 0.2. The
- -- \"snaplet path\" refers to the place on the URL where your containing
- -- snaplet is hung. The value of 'rqSnapletPath' is either @\"\"@ (at the
- -- top-level context) or is a path beginning with a slash, but not ending
- -- with one.
+ -- | We'll be doing web components (or \"snaplets\") for version 0.2.
+ -- The \"snaplet path\" refers to the place on the URL where your
+ -- containing snaplet is hung. The value of 'rqSnapletPath' is either
+ -- @\"\"@ (at the top-level context) or is a path beginning with a
+ -- slash, but not ending with one.
--
-- An identity is that:
--
@@ -234,18 +235,18 @@ data Request = Request
-- > , rqContextPath r
-- > , rqPathInfo r ]
--
- -- note that until we introduce snaplets in v0.2, 'rqSnapletPath' will be
- -- \"\"
+ -- note that until we introduce snaplets in v0.2, 'rqSnapletPath' will
+ -- be \"\"
, rqSnapletPath :: !ByteString
-- | Handlers can (/will be; --ed/) be hung on a @URI@ \"entry point\";
-- this is called the \"context path\". If a handler is hung on the
- -- context path @\"\/foo\/\"@, and you request @\"\/foo\/bar\"@, the
value
- -- of 'rqPathInfo' will be @\"bar\"@.
+ -- context path @\"\/foo\/\"@, and you request @\"\/foo\/bar\"@, the
+ -- value of 'rqPathInfo' will be @\"bar\"@.
, rqPathInfo :: !ByteString
- -- | The \"context path\" of the request; catenating 'rqContextPath', and
- -- 'rqPathInfo' should get you back to the original 'rqURI'. The
+ -- | The \"context path\" of the request; catenating 'rqContextPath',
+ -- and 'rqPathInfo' should get you back to the original 'rqURI'. The
-- 'rqContextPath' always begins and ends with a slash (@\"\/\"@)
-- character, and represents the path (relative to your
-- component\/snaplet) you took to get to your handler.
@@ -429,8 +430,8 @@ instance HasHeaders Response where
------------------------------------------------------------------------------
-- | Looks up the value(s) for the given named parameter. Parameters initially
-- come from the request's query string and any decoded POST body (if the
--- request's @Content-Type@ is @application\/x-www-form-urlencoded@). Parameter
--- values can be modified within handlers using "rqModifyParams".
+-- request's @Content-Type@ is @application\/x-www-form-urlencoded@).
+-- Parameter values can be modified within handlers using "rqModifyParams".
rqParam :: ByteString -- ^ parameter name to look up
-> Request -- ^ HTTP request
-> Maybe [ByteString]
@@ -439,8 +440,8 @@ rqParam k rq = Map.lookup k $ rqParams rq
------------------------------------------------------------------------------
--- | Modifies the parameters mapping (which is a @Map ByteString ByteString@)
in
--- a 'Request' using the given function.
+-- | Modifies the parameters mapping (which is a @Map ByteString ByteString@)
+-- in a 'Request' using the given function.
rqModifyParams :: (Params -> Params) -> Request -> Request
rqModifyParams f r = r { rqParams = p }
where
@@ -449,7 +450,8 @@ rqModifyParams f r = r { rqParams = p }
------------------------------------------------------------------------------
--- | Writes a key-value pair to the parameters mapping within the given
request.
+-- | Writes a key-value pair to the parameters mapping within the given
+-- request.
rqSetParam :: ByteString -- ^ parameter name
-> [ByteString] -- ^ parameter values
-> Request -- ^ request
@@ -529,21 +531,22 @@ addCookie (Cookie k v mbExpTime mbDomain mbPath) =
updateHeaders f
path = maybe "" (S.append "; path=") mbPath
domain = maybe "" (S.append "; domain=") mbDomain
exptime = maybe "" (S.append "; expires=" . fmt) mbExpTime
- fmt = fromStr . formatTime defaultTimeLocale "%a, %d-%b-%Y %H:%M:%S
GMT"
+ fmt = fromStr .
+ formatTime defaultTimeLocale "%a, %d-%b-%Y %H:%M:%S GMT"
------------------------------------------------------------------------------
-- | A note here: if you want to set the @Content-Length@ for the response,
--- Snap forces you to do it with this function rather than by setting it in the
--- headers; the @Content-Length@ in the headers will be ignored.
+-- Snap forces you to do it with this function rather than by setting it in
+-- the headers; the @Content-Length@ in the headers will be ignored.
--
-- The reason for this is that Snap needs to look up the value of
-- @Content-Length@ for each request, and looking the string value up in the
-- headers and parsing the number out of the text will be too expensive.
--
-- If you don't set a content length in your response, HTTP keep-alive will be
--- disabled for HTTP\/1.0 clients, forcing a @Connection: cl...@. For HTTP\/1.1
--- clients, Snap will switch to the chunked transfer encoding if
+-- disabled for HTTP\/1.0 clients, forcing a @Connection: cl...@. For
+-- HTTP\/1.1 clients, Snap will switch to the chunked transfer encoding if
-- @Content-Length@ is not specified.
setContentLength :: Int64 -> Response -> Response
setContentLength l r = r { rspContentLength = Just l }
diff --git a/src/Snap/Internal/Iteratee/Debug.hs
b/src/Snap/Internal/Iteratee/Debug.hs
index 188e1fa..f3c8f8c 100644
--- a/src/Snap/Internal/Iteratee/Debug.hs
+++ b/src/Snap/Internal/Iteratee/Debug.hs
@@ -54,7 +54,8 @@ iterateeDebugWrapper name iter = do
where
whatWasReturn (Continue _) = debug $ name ++ ": continue"
- whatWasReturn (Yield _ z) = debug $ name ++ ": yield, with remainder " ++
show z
+ whatWasReturn (Yield _ z) = debug $ name ++ ": yield, with remainder "
+ ++ show z
whatWasReturn (Error e) = debug $ name ++ ": error, with " ++ show e
check (Continue k) = continue $ f k
diff --git a/src/Snap/Internal/Routing.hs b/src/Snap/Internal/Routing.hs
index a97a1fe..3283e90 100644
--- a/src/Snap/Internal/Routing.hs
+++ b/src/Snap/Internal/Routing.hs
@@ -36,9 +36,11 @@ triggering its fallback. It's NoRoute, so we go to the
nearest parent
fallback and try that, which is the baz action.
-}
-data Route a m = Action ((MonadSnap m) => m a) -- wraps a 'Snap'
action
- | Capture ByteString (Route a m) (Route a m) -- captures the
dir in a param
- | Dir (Map.Map ByteString (Route a m)) (Route a m) -- match on
a dir
+data Route a m = Action ((MonadSnap m) => m a) -- wraps a 'Snap' action
+ -- captures the dir in a param
+ | Capture ByteString (Route a m) (Route a m)
+ -- match on a dir
+ | Dir (Map.Map ByteString (Route a m)) (Route a m)
| NoRoute
@@ -137,8 +139,8 @@ routeEarliestNC r n = case r of
--
-- > [ ("a", h1), ("a/b", h2), ("a/:x", h3) ]
--
--- a request for \"@\/a\/b...@\" will go to @h2@, \"@\/a\/s...@\" for any /s/
will go
--- to @h3@, and \"@\/a...@\" will go to @h...@.
+-- a request for \"@\/a\/b...@\" will go to @h2@, \"@\/a\/s...@\" for any /s/
will
+-- go to @h3@, and \"@\/a...@\" will go to @h...@.
--
-- The following example matches \"@\/arti...@\" to an article index,
-- \"@\/lo...@\" to a login, and \"@\/article\/....@\" to an article renderer.
@@ -156,8 +158,8 @@ route rts = do
------------------------------------------------------------------------------
--- | The 'routeLocal' function is the same as 'route'', except it doesn't
change
--- the request's context path. This is useful if you want to route to a
+-- | The 'routeLocal' function is the same as 'route'', except it doesn't
+-- change the request's context path. This is useful if you want to route to a
-- particular handler but you want that handler to receive the 'rqPathInfo' as
-- it is.
routeLocal :: MonadSnap m => [(ByteString, m a)] -> m a
@@ -173,6 +175,7 @@ routeLocal rts = do
where
rts' = mconcat (map pRoute rts)
+
------------------------------------------------------------------------------
splitPath :: ByteString -> [ByteString]
splitPath = B.splitWith (== (c2w '/'))
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index de80c08..06c679f 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -78,8 +78,8 @@ import Snap.Internal.Iteratee.Debug
> r <- getResponse
> finishWith r
- then any subsequent processing will be skipped and supplied 'Response' value
- will be returned from 'runSnap' as-is.
+ then any subsequent processing will be skipped and supplied 'Response'
+ value will be returned from 'runSnap' as-is.
6. access to the 'IO' monad through a 'MonadIO' instance:
@@ -103,9 +103,11 @@ class (Monad m, MonadIO m, MonadCatchIO m, MonadPlus m,
Functor m,
Applicative m, Alternative m) => MonadSnap m where
liftSnap :: Snap a -> m a
+
------------------------------------------------------------------------------
newtype Snap a = Snap {
- unSnap :: StateT SnapState (Iteratee ByteString IO) (Maybe (Either
Response a))
+ unSnap :: StateT SnapState (Iteratee ByteString IO)
+ (Maybe (Either Response a))
}
@@ -228,10 +230,10 @@ getRequestBody = liftM L.fromChunks $ runRequestBody
consume
------------------------------------------------------------------------------
--- | Normally Snap is careful to ensure that the request body is fully consumed
--- after your web handler runs, but before the 'Response' enumerator is
--- streamed out the socket. If you want to transform the request body into some
--- output in O(1) space, you should use this function.
+-- | Normally Snap is careful to ensure that the request body is fully
+-- consumed after your web handler runs, but before the 'Response' enumerator
+-- is streamed out the socket. If you want to transform the request body into
+-- some output in O(1) space, you should use this function.
--
-- Note that upon calling this function, response processing finishes early as
-- if you called 'finishWith'. Make sure you set any content types, headers,
@@ -337,10 +339,10 @@ dir = pathWith f
------------------------------------------------------------------------------
--- | Runs a 'Snap' monad action only for requests where 'rqPathInfo' is exactly
--- equal to the given string. If the path matches, locally sets 'rqContextPath'
--- to the old value of 'rqPathInfo', sets 'rqPathInfo'=\"\", and runs the given
--- handler.
+-- | Runs a 'Snap' monad action only for requests where 'rqPathInfo' is
+-- exactly equal to the given string. If the path matches, locally sets
+-- 'rqContextPath' to the old value of 'rqPathInfo', sets 'rqPathInfo'=\"\",
+-- and runs the given handler.
path :: MonadSnap m
=> ByteString -- ^ path to match against
-> m a -- ^ handler to run
@@ -417,9 +419,9 @@ modifyResponse f = liftSnap $
------------------------------------------------------------------------------
-- | Performs a redirect by setting the @Location@ header to the given target
-- URL/path and the status code to 302 in the 'Response' object stored in a
--- 'Snap' monad. Note that the target URL is not validated in any way. Consider
--- using 'redirect\'' instead, which allows you to choose the correct status
--- code.
+-- 'Snap' monad. Note that the target URL is not validated in any way.
+-- Consider using 'redirect\'' instead, which allows you to choose the correct
+-- status code.
redirect :: MonadSnap m => ByteString -> m ()
redirect target = redirect' target 302
{-# INLINE redirect #-}
@@ -461,8 +463,8 @@ addToOutput enum = modifyResponse $ modifyResponseBody
(>==> enum)
------------------------------------------------------------------------------
--- | Adds the given strict 'ByteString' to the body of the 'Response' stored in
--- the 'Snap' monad state.
+-- | Adds the given strict 'ByteString' to the body of the 'Response' stored
+-- in the 'Snap' monad state.
--
-- Warning: This function is intentionally non-strict. If any pure
-- exceptions are raised by the expression creating the 'ByteString',
@@ -472,8 +474,8 @@ writeBS s = addToOutput $ enumBS s
------------------------------------------------------------------------------
--- | Adds the given lazy 'L.ByteString' to the body of the 'Response' stored in
--- the 'Snap' monad state.
+-- | Adds the given lazy 'L.ByteString' to the body of the 'Response' stored
+-- in the 'Snap' monad state.
--
-- Warning: This function is intentionally non-strict. If any pure
-- exceptions are raised by the expression creating the 'ByteString',
@@ -483,8 +485,8 @@ writeLBS s = addToOutput $ enumLBS s
------------------------------------------------------------------------------
--- | Adds the given strict 'T.Text' to the body of the 'Response' stored in the
--- 'Snap' monad state.
+-- | Adds the given strict 'T.Text' to the body of the 'Response' stored in
+-- the 'Snap' monad state.
--
-- Warning: This function is intentionally non-strict. If any pure
-- exceptions are raised by the expression creating the 'ByteString',
@@ -512,23 +514,23 @@ writeLazyText s = writeLBS $ LT.encodeUtf8 s
-- 'sendFile', Snap will use the efficient @sendfile()@ system call on
-- platforms that support it.
--
--- If the response body is modified (using 'modifyResponseBody'), the file will
--- be read using @mmap()@.
+-- If the response body is modified (using 'modifyResponseBody'), the file
+-- will be read using @mmap()@.
sendFile :: (MonadSnap m) => FilePath -> m ()
sendFile f = modifyResponse $ \r -> r { rspBody = SendFile f Nothing }
------------------------------------------------------------------------------
--- | Sets the output to be the contents of the specified file, within the given
--- (start,end) range.
+-- | Sets the output to be the contents of the specified file, within the
+-- given (start,end) range.
--
--- Calling 'sendFilePartial' will overwrite any output queued to be sent in the
--- 'Response'. If the response body is not modified after the call to
+-- Calling 'sendFilePartial' will overwrite any output queued to be sent in
+-- the 'Response'. If the response body is not modified after the call to
-- 'sendFilePartial', Snap will use the efficient @sendfile()@ system call on
-- platforms that support it.
--
--- If the response body is modified (using 'modifyResponseBody'), the file will
--- be read using @mmap()@.
+-- If the response body is modified (using 'modifyResponseBody'), the file
+-- will be read using @mmap()@.
sendFilePartial :: (MonadSnap m) => FilePath -> (Int64,Int64) -> m ()
sendFilePartial f rng = modifyResponse $ \r ->
r { rspBody = SendFile f (Just rng) }
diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
index 061fa8d..a110b33 100644
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@ -7,10 +7,10 @@
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
+------------------------------------------------------------------------------
-- | Snap Framework type aliases and utilities for iteratees. Note that as a
--- convenience, this module also exports everything from @Data.Enumerator@ in
the
--- @enumerator@ library.
---
+-- convenience, this module also exports everything from @Data.Enumerator@ in
+-- the @enumerator@ library.
module Snap.Iteratee
(
@@ -213,12 +213,11 @@ mkIterateeBuffer = mallocPlainForeignPtrBytes bUFSIZ
------------------------------------------------------------------------------
--- | Buffers an iteratee, \"unsafely\". Here we use a fixed binary buffer which
--- we'll re-use, meaning that if you hold on to any of the bytestring data
--- passed into your iteratee (instead of, let's say, shoving it right out a
--- socket) it'll get changed out from underneath you, breaking referential
+-- | Buffers an iteratee, \"unsafely\". Here we use a fixed binary buffer
+-- which we'll re-use, meaning that if you hold on to any of the bytestring
+-- data passed into your iteratee (instead of, let's say, shoving it right out
+-- a socket) it'll get changed out from underneath you, breaking referential
-- transparency. Use with caution!
---
unsafeBufferIteratee :: Iteratee ByteString IO a
-> IO (Iteratee ByteString IO a)
unsafeBufferIteratee step = do
@@ -227,10 +226,10 @@ unsafeBufferIteratee step = do
------------------------------------------------------------------------------
--- | Buffers an iteratee, \"unsafely\". Here we use a fixed binary buffer which
--- we'll re-use, meaning that if you hold on to any of the bytestring data
--- passed into your iteratee (instead of, let's say, shoving it right out a
--- socket) it'll get changed out from underneath you, breaking referential
+-- | Buffers an iteratee, \"unsafely\". Here we use a fixed binary buffer
+-- which we'll re-use, meaning that if you hold on to any of the bytestring
+-- data passed into your iteratee (instead of, let's say, shoving it right out
+-- a socket) it'll get changed out from underneath you, breaking referential
-- transparency. Use with caution!
--
-- This version accepts a buffer created by 'mkIterateeBuffer'.
@@ -386,28 +385,41 @@ drop' !n = continue k
else yield () $ Chunks ((S.drop (fromEnum m) x):xs)
+------------------------------------------------------------------------------
data ShortWriteException = ShortWriteException
deriving (Typeable)
+
+------------------------------------------------------------------------------
instance Show ShortWriteException where
show ShortWriteException = "Short write"
+
+------------------------------------------------------------------------------
instance Exception ShortWriteException
+------------------------------------------------------------------------------
data TooManyBytesReadException = TooManyBytesReadException
deriving (Typeable)
+
+------------------------------------------------------------------------------
instance Show TooManyBytesReadException where
show TooManyBytesReadException = "Too many bytes read"
+
+------------------------------------------------------------------------------
instance Exception TooManyBytesReadException
+
+------------------------------------------------------------------------------
take :: (Monad m) => Int -> Enumeratee ByteString ByteString m a
take k = take' (toEnum k)
+------------------------------------------------------------------------------
take' :: (Monad m) => Int64 -> Enumeratee ByteString ByteString m a
take' _ y@(Yield _ _ ) = return y
take' _ (Error e ) = throwError e
@@ -482,8 +494,7 @@ takeExactly !n st@(Continue k) = do
(s1,s2) = S.splitAt (fromEnum n) x
-
-
+------------------------------------------------------------------------------
takeNoMoreThan :: (Monad m) =>
Int64 -> Enumeratee ByteString ByteString m a
takeNoMoreThan _ y@(Yield _ _) = return y
@@ -520,16 +531,18 @@ _enumFile fp iter = do
enumHandle 32678 h iter `finally` (liftIO $ hClose h)
-
------------------------------------------------------------------------------
data InvalidRangeException = InvalidRangeException
deriving (Typeable)
+
+------------------------------------------------------------------------------
instance Show InvalidRangeException where
show InvalidRangeException = "Invalid range"
-instance Exception InvalidRangeException
+------------------------------------------------------------------------------
+instance Exception InvalidRangeException
------------------------------------------------------------------------------
@@ -549,6 +562,7 @@ _enumFilePartial fp (start,end) iter = do
enumHandle 32678 h step)
+------------------------------------------------------------------------------
enumFile :: FilePath -> Enumerator ByteString IO a
enumFilePartial :: FilePath
-> (Int64,Int64)
@@ -568,17 +582,20 @@ enumFilePartial fp rng@(start,end) iter = do
maxMMapFileSize :: FileOffset
maxMMapFileSize = 41943040
+
+------------------------------------------------------------------------------
tooBigForMMap :: FilePath -> IO Bool
tooBigForMMap fp = do
stat <- getFileStatus fp
return $ fileSize stat > maxMMapFileSize
+------------------------------------------------------------------------------
enumFile _ (Error e) = throwError e
enumFile _ (Yield x _) = yield x EOF
enumFile fp st@(Continue k) = do
- -- for small files we'll use mmap to save ourselves a copy, otherwise we'll
- -- stream it
+ -- for small files we'll use mmap to save ourselves a copy, otherwise
+ -- we'll stream it
tooBig <- lift $ tooBigForMMap fp
if tooBig
@@ -590,6 +607,7 @@ enumFile fp st@(Continue k) = do
(Right s) -> k $ Chunks [s]
+------------------------------------------------------------------------------
enumFilePartial _ _ (Error e) = throwError e
enumFilePartial _ _ (Yield x _) = yield x EOF
enumFilePartial fp rng@(start,end) st@(Continue k) = do
diff --git a/src/Snap/Util/FileServe.hs b/src/Snap/Util/FileServe.hs
index 575b611..0f1db50 100644
--- a/src/Snap/Util/FileServe.hs
+++ b/src/Snap/Util/FileServe.hs
@@ -186,9 +186,9 @@ getSafePath = do
------------------------------------------------------------------------------
-- | Serves files out of the given directory. The relative path given in
--- 'rqPathInfo' is searched for the given file, and the file is served with the
--- appropriate mime type if it is found. Absolute paths and \"@....@\" are
prohibited
--- to prevent files from being served from outside the sandbox.
+-- 'rqPathInfo' is searched for the given file, and the file is served with
+-- the appropriate mime type if it is found. Absolute paths and \"@....@\" are
+-- prohibited to prevent files from being served from outside the sandbox.
--
-- Uses 'defaultMimeTypes' to determine the @Content-Type@ based on the file's
-- extension.
@@ -279,7 +279,8 @@ fileServeSingle' mime fp = do
-- now check: is this a range request? If there is an 'If-Range' header
- -- with an old modification time we skip this check and send a 200 response
+ -- with an old modification time we skip this check and send a 200
+ -- response
let skipRangeCheck = maybe (False)
(\lt -> mt > lt)
mbIfRange
@@ -427,6 +428,6 @@ checkRangeReq req fp sz = do
return True
-
+------------------------------------------------------------------------------
dbg :: (MonadIO m) => String -> m ()
dbg s = debug $ "FileServe:" ++ s
diff --git a/src/Snap/Util/GZip.hs b/src/Snap/Util/GZip.hs
index 621a7c7..ba38c9b 100644
--- a/src/Snap/Util/GZip.hs
+++ b/src/Snap/Util/GZip.hs
@@ -54,8 +54,8 @@ import Snap.Types
--
-- Then the given handler's output stream will be compressed,
-- @Content-Encoding@ will be set in the output headers, and the
--- @Content-Length@ will be cleared if it was set. (We can't process the stream
--- in O(1) space if the length is known beforehand.)
+-- @Content-Length@ will be cleared if it was set. (We can't process the
+-- stream in O(1) space if the length is known beforehand.)
--
-- The wrapped handler will be run to completion, and then the 'Response'
-- that's contained within the 'Snap' monad state will be passed to
@@ -197,7 +197,8 @@ compressEnumerator compFunc enum origStep = do
ech <- lift $ readChan writeEnd
either throwError
(\ch -> do
- step' <- checkDone (\k -> lift $ runIteratee $ k ch)
step
+ step' <- checkDone (\k -> lift $ runIteratee $ k ch)
+ step
consumeSomeOutput writeEnd step')
ech
commit 99b33115a4c7bd3f5912caaed53a457b426c75c4
Author: Mighty Byte <[email protected]>
Date: Sun Dec 12 16:46:23 2010 -0500
Remove trailing whitespace.
diff --git a/src/Snap/Internal/Debug.hs b/src/Snap/Internal/Debug.hs
index 4ddcb71..52bc122 100644
--- a/src/Snap/Internal/Debug.hs
+++ b/src/Snap/Internal/Debug.hs
@@ -38,7 +38,7 @@ debug, debugErrno :: forall m . (MonadIO m => String -> m ())
{-# NOINLINE debug #-}
debug = let !x = unsafePerformIO $! do
!e <- try $ getEnv "DEBUG"
-
+
!f <- either (\(_::SomeException) -> return debugIgnore)
(\y -> if y == "1" || y == "on"
then return debugOn
@@ -53,7 +53,7 @@ debug = let !x = unsafePerformIO $! do
{-# NOINLINE debugErrno #-}
debugErrno = let !x = unsafePerformIO $ do
e <- try $ getEnv "DEBUG"
-
+
!f <- either (\(_::SomeException) -> return debugErrnoIgnore)
(\y -> if y == "1" || y == "on"
then return debugErrnoOn
diff --git a/src/Snap/Internal/Http/Types.hs b/src/Snap/Internal/Http/Types.hs
index cd2e8ed..62ea1e8 100644
--- a/src/Snap/Internal/Http/Types.hs
+++ b/src/Snap/Internal/Http/Types.hs
@@ -652,7 +652,7 @@ pUrlEscaped = do
when (S.length hx /= 2 ||
(not $ S.all (isHexDigit . w2c) hx)) $
fail "bad hex in url"
-
+
let code = (Cvt.hex hx) :: Word8
nextChunk $ DL.snoc l (S.singleton code)
diff --git a/src/Snap/Util/FileServe.hs b/src/Snap/Util/FileServe.hs
index 79b064c..575b611 100644
--- a/src/Snap/Util/FileServe.hs
+++ b/src/Snap/Util/FileServe.hs
@@ -415,7 +415,7 @@ checkRangeReq req fp sz = do
let crng = S.concat $
L.toChunks $
L.concat ["bytes */", show sz]
-
+
modifyResponse $ setResponseCode 416
. setHeader "Content-Range" crng
. setContentLength 0
@@ -423,7 +423,7 @@ checkRangeReq req fp sz = do
. deleteHeader "Content-Encoding"
. deleteHeader "Transfer-Encoding"
. setResponseBody (enumBS "")
-
+
return True
diff --git a/src/Snap/Util/GZip.hs b/src/Snap/Util/GZip.hs
index c658e09..621a7c7 100644
--- a/src/Snap/Util/GZip.hs
+++ b/src/Snap/Util/GZip.hs
@@ -218,7 +218,7 @@ compressEnumerator compFunc enum origStep = do
--------------------------------------------------------------------------
f _ _ _ (Error e) = Error e
f _ _ _ (Yield x _) = Yield x EOF
- f readEnd writeEnd tid st@(Continue k) = Continue $ \ch ->
+ f readEnd writeEnd tid st@(Continue k) = Continue $ \ch ->
case ch of
EOF -> do
lift $ writeChan readEnd Nothing
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
