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 2e98e583878146f5e81bf887ada8cc34d787a44e (commit)
from d6ac45b33e5f167a3fdabd6961cc085704a37621 (commit)
Summary of changes:
snap-core.cabal | 2 +-
src/Snap/Internal/Types.hs | 29 ++++++++++++++++++++++-------
src/Snap/Types.hs | 3 +++
3 files changed, 26 insertions(+), 8 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 2e98e583878146f5e81bf887ada8cc34d787a44e
Author: Shu-yu Guo <[email protected]>
Date: Sun May 23 13:49:14 2010 -0700
Expose error logging to the Snap monad
diff --git a/snap-core.cabal b/snap-core.cabal
index c9c0e6d..5a95cdd 100644
--- a/snap-core.cabal
+++ b/snap-core.cabal
@@ -1,5 +1,5 @@
name: snap-core
-version: 0.1.3
+version: 0.1.4
synopsis: Snap: A Haskell Web Framework (Core)
description:
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index 15dfb2a..ed2509e 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -90,7 +90,8 @@ newtype Snap a = Snap {
------------------------------------------------------------------------------
data SnapState = SnapState
{ _snapRequest :: Request
- , _snapResponse :: Response }
+ , _snapResponse :: Response
+ , _snapLogError :: ByteString -> IO () }
------------------------------------------------------------------------------
@@ -357,6 +358,14 @@ modifyResponse f = smodify $ \ss -> ss { _snapResponse = f
$ _snapResponse ss }
------------------------------------------------------------------------------
+-- | Log an error message in the 'Snap' monad
+logError :: ByteString -> Snap ()
+logError s = Snap $ gets _snapLogError >>= (\l -> liftIO $ l s)
+ >> return (Just $ Right ())
+{-# INLINE logError #-}
+
+
+------------------------------------------------------------------------------
-- | Adds the output from the given enumerator to the 'Response'
-- stored in the 'Snap' monad state.
addToOutput :: (forall a . Enumerator a) -- ^ output to add
@@ -456,8 +465,11 @@ instance Exception NoHandlerException
------------------------------------------------------------------------------
-- | Runs a 'Snap' monad action in the 'Iteratee IO' monad.
-runSnap :: Snap a -> Request -> Iteratee IO (Request,Response)
-runSnap (Snap m) req = do
+runSnap :: Snap a
+ -> Request
+ -> (ByteString -> IO ())
+ -> Iteratee IO (Request,Response)
+runSnap (Snap m) req logerr = do
(r, ss') <- runStateT m ss
e <- maybe (return $ Left fourohfour)
@@ -479,13 +491,16 @@ runSnap (Snap m) req = do
dresp = emptyResponse { rspHttpVersion = rqVersion req }
- ss = SnapState req dresp
+ ss = SnapState req dresp logerr
{-# INLINE runSnap #-}
------------------------------------------------------------------------------
-evalSnap :: Snap a -> Request -> Iteratee IO a
-evalSnap (Snap m) req = do
+evalSnap :: Snap a
+ -> Request
+ -> (ByteString -> IO ())
+ -> Iteratee IO a
+evalSnap (Snap m) req logerr = do
(r, _) <- runStateT m ss
e <- maybe (liftIO $ throwIO NoHandlerException)
@@ -498,7 +513,7 @@ evalSnap (Snap m) req = do
Right x -> return x
where
dresp = emptyResponse { rspHttpVersion = rqVersion req }
- ss = SnapState req dresp
+ ss = SnapState req dresp logerr
{-# INLINE evalSnap #-}
diff --git a/src/Snap/Types.hs b/src/Snap/Types.hs
index b8a245a..ba327c8 100644
--- a/src/Snap/Types.hs
+++ b/src/Snap/Types.hs
@@ -34,6 +34,9 @@ module Snap.Types
, withRequest
, withResponse
+ -- ** Logging
+ , logError
+
-- ** Grabbing request bodies
, runRequestBody
, getRequestBody
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
