classy-prelude 0.5.8 → 0.5.9
raw patch · 3 files changed
+121/−5 lines, 3 filesdep +asyncdep +deepseqPVP ok
version bump matches the API change (PVP)
Dependencies added: async, deepseq
API changes (from Hackage documentation)
+ ClassyPrelude: catchAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> (SomeException -> m a) -> m a
+ ClassyPrelude: handleAnyDeep :: (NFData a, MonadBaseControl IO m) => (SomeException -> m a) -> m a -> m a
+ ClassyPrelude: trace :: String -> a -> a
+ ClassyPrelude: traceId :: String -> String
+ ClassyPrelude: traceM :: Monad m => String -> m ()
+ ClassyPrelude: traceShow :: Show a => a -> b -> b
+ ClassyPrelude: traceShowId :: Show a => a -> a
+ ClassyPrelude: traceShowM :: (Show a, Monad m) => a -> m ()
+ ClassyPrelude: tryAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> m (Either SomeException a)
Files
- ClassyPrelude.hs +80/−4
- classy-prelude.cabal +3/−1
- test/main.hs +38/−0
ClassyPrelude.hs view
@@ -18,6 +18,13 @@ -- ** Mutable references , module Control.Concurrent.MVar.Lifted , module Data.IORef.Lifted+ -- ** Debugging+ , trace+ , traceShow+ , traceId+ , traceM+ , traceShowId+ , traceShowM -- * Non-standard -- ** List-like classes , map@@ -118,6 +125,9 @@ , catchAny , handleAny , tryAny+ , catchAnyDeep+ , handleAnyDeep+ , tryAnyDeep , catchIO , handleIO , tryIO@@ -141,13 +151,15 @@ import qualified Prelude import Control.Monad (when, unless, void, liftM, ap, forever, join, sequence, sequence_)-import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM)+import Control.Concurrent.Async (withAsync, waitCatch) import Control.Concurrent.MVar.Lifted import Data.IORef.Lifted import Data.Monoid (Monoid) import qualified Data.Monoid as Monoid import Data.Foldable (Foldable) import qualified Data.Foldable as Foldable+import Control.DeepSeq (NFData, ($!!)) import CorePrelude hiding (print, undefined) import ClassyPrelude.Classes@@ -169,6 +181,7 @@ import ClassyPrelude.UVector () import ClassyPrelude.Sequence (Seq) +import Debug.Trace (trace, traceShow) show :: (Show a, CanPack c Char) => a -> c show = pack . Prelude.show@@ -307,24 +320,63 @@ -- | A version of 'catch' which is specialized for any exception. This -- simplifies usage as no explicit type signatures are necessary. --+-- Note that since version 0.5.9, this function now has proper support for+-- asynchronous exceptions, by only catching exceptions generated by the+-- internal action.+-- -- Since 0.5.6 catchAny :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a-catchAny = catch+catchAny action onE = tryAny action >>= either onE return -- | A version of 'handle' which is specialized for any exception. This -- simplifies usage as no explicit type signatures are necessary. --+-- Note that since version 0.5.9, this function now has proper support for+-- asynchronous exceptions, by only catching exceptions generated by the+-- internal action.+-- -- Since 0.5.6 handleAny :: MonadBaseControl IO m => (SomeException -> m a) -> m a -> m a-handleAny = handle+handleAny = flip catchAny -- | A version of 'try' which is specialized for any exception. -- This simplifies usage as no explicit type signatures are necessary. --+-- Note that since version 0.5.9, this function now has proper support for+-- asynchronous exceptions, by only catching exceptions generated by the+-- internal action.+-- -- Since 0.5.6 tryAny :: MonadBaseControl IO m => m a -> m (Either SomeException a)-tryAny = try+tryAny m =+ liftBaseWith (\runInIO -> withAsync (runInIO m) waitCatch) >>=+ either (return . Left) (liftM Right . restoreM) +-- | An extension to @catchAny@ which ensures that the return value is fully+-- evaluated. See @tryAnyDeep@.+--+-- Since 0.5.9+catchAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> (SomeException -> m a) -> m a+catchAnyDeep action onE = tryAnyDeep action >>= either onE return++-- | @flip catchAnyDeep@+--+-- Since 0.5.6+handleAnyDeep :: (NFData a, MonadBaseControl IO m) => (SomeException -> m a) -> m a -> m a+handleAnyDeep = flip catchAnyDeep++-- | An extension to @tryAny@ which ensures that the return value is fully+-- evaluated. In other words, if you get a @Right@ response here, you can be+-- confident that using it will not result in another exception.+--+-- Since 0.5.9+tryAnyDeep :: (NFData a, MonadBaseControl IO m)+ => m a+ -> m (Either SomeException a)+tryAnyDeep m = tryAny $ do+ x <- m+ return $!! x+ -- | A version of 'catch' which is specialized for IO exceptions. This -- simplifies usage as no explicit type signatures are necessary. --@@ -357,3 +409,27 @@ -- Since 0.5.6 asIOException :: IOException -> IOException asIOException = id++-- |+--+-- Since 0.5.9+traceId :: String -> String+traceId a = trace a a++-- |+--+-- Since 0.5.9+traceM :: (Monad m) => String -> m ()+traceM string = trace string $ return ()++-- |+--+-- Since 0.5.9+traceShowId :: (Show a) => a -> a+traceShowId a = trace (show a) a++-- |+--+-- Since 0.5.9+traceShowM :: (Show a, Monad m) => a -> m ()+traceShowM = traceM . show
classy-prelude.cabal view
@@ -1,5 +1,5 @@ name: classy-prelude-version: 0.5.8+version: 0.5.9 synopsis: A typeclass-based Prelude. description: Focuses on using common typeclasses when possible, and creating new ones to avoid name clashing. Exposes many recommended datastructures (Map, ByteString, etc) directly without requiring long import lists and qualified modules. homepage: https://github.com/snoyberg/classy-prelude@@ -41,6 +41,8 @@ , hashable , lifted-base >= 0.2 , monad-control+ , async >= 2.0+ , deepseq ghc-options: -Wall -fno-warn-orphans test-suite test
test/main.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PatternGuards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Test.Hspec import Test.Hspec.QuickCheck@@ -13,6 +15,8 @@ import Control.Monad.Trans.Writer (tell, Writer, runWriter) import Data.Maybe (isJust) import Data.Functor.Identity (runIdentity)+import Control.Concurrent (throwTo, threadDelay, forkIO)+import Control.Exception (throw) dictionaryProps :: ( CanInsertVal a Int Char@@ -379,6 +383,40 @@ describe "Vector" $ prefixProps (undefined :: Vector Int) describe "UVector" $ prefixProps (undefined :: UVector Int) describe "Seq" $ prefixProps (undefined :: Seq Int)+ describe "any exceptions" $ do+ it "catchAny" $ do+ failed <- newIORef 0+ tid <- forkIO $ do+ catchAny+ (threadDelay 20000)+ (const $ writeIORef failed 1)+ writeIORef failed 2+ threadDelay 10000+ throwTo tid DummyException+ threadDelay 50000+ didFail <- readIORef failed+ liftIO $ didFail `shouldBe` 0+ it "tryAny" $ do+ failed <- newIORef False+ tid <- forkIO $ do+ _ <- tryAny $ threadDelay 20000+ writeIORef failed True+ threadDelay 10000+ throwTo tid DummyException+ threadDelay 50000+ didFail <- readIORef failed+ liftIO $ didFail `shouldBe` False+ it "tryAnyDeep" $ do+ eres <- tryAnyDeep $ return $ throw DummyException+ case eres of+ Left e+ | Just DummyException <- fromException e -> return ()+ | otherwise -> error "Expected a DummyException"+ Right () -> error "Expected an exception" :: IO ()++data DummyException = DummyException+ deriving (Show, Typeable)+instance Exception DummyException instance Arbitrary (Map Int Char) where arbitrary = fromList <$> arbitrary