[Snap Framework] snap-core branch, master, updated. 86794947a86fa4f01326f8511b0fdd3be7bd9151

noreply at snapframework.com noreply at snapframework.com
Wed Apr 28 02:57:56 CDT 2010


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  86794947a86fa4f01326f8511b0fdd3be7bd9151 (commit)
      from  a0508bd653b3c694ad29f9eaa0b06a182d54b2c4 (commit)


Summary of changes:
 snap-core.cabal                |    1 +
 src/Snap/Internal/Types.hs     |   20 ++++++++++++--------
 src/Snap/Iteratee.hs           |   28 ++++++++++++++++++++++++++--
 test/snap-core-testsuite.cabal |    1 +
 4 files changed, 40 insertions(+), 10 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 86794947a86fa4f01326f8511b0fdd3be7bd9151
Author: Gregory Collins <greg at gregorycollins.net>
Date:   Wed Apr 28 03:57:51 2010 -0400

    Add an instance for MonadCatchIO

diff --git a/snap-core.cabal b/snap-core.cabal
index f3f3ae4..9e64058 100644
--- a/snap-core.cabal
+++ b/snap-core.cabal
@@ -71,6 +71,7 @@ Library
     dlist >= 0.5 && < 0.6,
     filepath,
     iteratee >= 0.3.1 && <0.4,
+    MonadCatchIO-transformers >= 0.2 && < 0.3,
     monads-fd,
     old-locale,
     old-time,
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index e70512e..0a356f0 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -7,7 +7,8 @@ module Snap.Internal.Types where
 
 ------------------------------------------------------------------------------
 import           Control.Applicative
-import           Control.Exception
+import           Control.Exception (throwIO, ErrorCall(..))
+import           Control.Monad.CatchIO
 import           Control.Monad.State.Strict
 import           Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -18,13 +19,7 @@ import           Data.Maybe
 import           Data.Typeable
 
 ------------------------------------------------------------------------------
-import           Snap.Iteratee ( Iteratee
-                               , (>.)
-                               , fromWrap
-                               , stream2stream
-                               , enumBS
-                               , enumLBS )
-
+import           Snap.Iteratee hiding (Enumerator)
 import           Snap.Internal.Http.Types
 
 
@@ -105,6 +100,15 @@ instance Monad Snap where
 instance MonadIO Snap where
     liftIO m = Snap $ liftM (Just . Right) $ liftIO m
 
+instance MonadCatchIO Snap where
+    catch (Snap m) handler = Snap $ do
+        x <- try m
+        case x of
+          (Left e)  -> let (Snap z) = handler e in z
+          (Right x) -> return x
+
+    block (Snap m) = Snap $ block m
+    unblock (Snap m) = Snap $ unblock m
 
 instance MonadPlus Snap where
     mzero = Snap $ return Nothing
diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
index c7f62ac..0ffaab1 100644
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Snap Framework type aliases and utilities for iteratees. Note that as a
 -- convenience, this module also exports everything from @Data.Iteratee@ in the
@@ -37,8 +38,10 @@ module Snap.Iteratee
   ) where
 
 ------------------------------------------------------------------------------
-import           Control.Exception
+import           Control.Exception (SomeException)
 import           Control.Monad
+import           Control.Monad.CatchIO
+import           Control.Monad.State.Strict
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
@@ -46,7 +49,7 @@ import           Data.Iteratee
 import qualified Data.Iteratee.Base.StreamChunk as SC
 import           Data.Iteratee.WrappedByteString
 import           Data.Word (Word8)
-import           Prelude hiding (drop)
+import           Prelude hiding (catch,drop)
 import           System.IO.Posix.MMap
 import qualified Data.DList as D
 ------------------------------------------------------------------------------
@@ -57,6 +60,27 @@ type Iteratee   m   = IterateeG WrappedByteString Word8 m
 type Enumerator m a = Iteratee m a -> m (Iteratee m a)
 
 
+-- TEMPORARY until MonadCatchIO-transformers is fixed
+instance MonadCatchIO m => MonadCatchIO (StateT s m) where
+  m `catch` f = StateT $ \s -> runStateT m s `catch` \e -> runStateT (f e) s
+  block       = mapStateT block
+  unblock     = mapStateT unblock
+
+
+instance (Functor m, MonadCatchIO m) =>
+         MonadCatchIO (IterateeG s el m) where
+    --catch  :: Exception  e => m a -> (e -> m a) -> m a
+    catch m handler = IterateeG $ \str -> do
+        ee <- try $ runIter m str
+        case ee of 
+          (Left e)  -> runIter (handler e) str
+          (Right v) -> return v
+
+    --block :: m a -> m a        
+    block m = IterateeG $ \str -> block $ runIter m str
+    unblock m = IterateeG $ \str -> unblock $ runIter m str
+
+
 -- | Wraps an 'Iteratee', counting the number of bytes consumed by it.
 countBytes :: (Monad m) => Iteratee m a -> Iteratee m (a, Int)
 countBytes = go 0
diff --git a/test/snap-core-testsuite.cabal b/test/snap-core-testsuite.cabal
index d389fe7..3932df5 100644
--- a/test/snap-core-testsuite.cabal
+++ b/test/snap-core-testsuite.cabal
@@ -23,6 +23,7 @@ Executable testsuite
      filepath,
      HUnit >= 1.2 && < 2,
      iteratee >= 0.3.1 && < 0.4,
+     MonadCatchIO-transformers >= 0.2 && < 0.3,
      monads-fd,
      old-locale,
      old-time,
-----------------------------------------------------------------------


hooks/post-receive
-- 
snap-core


More information about the Snap mailing list