extensible-effects 1.6.0 → 1.7.1

raw patch · 17 files changed

+53/−46 lines, 17 filesdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• extensible-effects.cabal +5/−5
• src/Control/Eff.hs +6/−6
• src/Control/Eff/Choose.hs +2/−2
• src/Control/Eff/Coroutine.hs +1/−1
• src/Control/Eff/Cut.hs +1/−1
• src/Control/Eff/Exception.hs +2/−2
• src/Control/Eff/Fresh.hs +1/−1
• src/Control/Eff/Lift.hs +9/−11
• src/Control/Eff/Reader/Lazy.hs +1/−1
• src/Control/Eff/Reader/Strict.hs +1/−1
• src/Control/Eff/State/Lazy.hs +1/−1
• src/Control/Eff/State/Strict.hs +1/−1
• src/Control/Eff/Trace.hs +1/−1
• src/Control/Eff/Writer/Lazy.hs +1/−1
• src/Control/Eff/Writer/Strict.hs +1/−1
• src/Data/OpenUnion1.hs +1/−2
• test/Test.hs +18/−8

@@ -1,5 +1,5 @@ Name:                extensible-effects-Version:             1.6.0+Version:             1.7.1 Synopsis:            An Alternative to Monad Transformers Description:         This package introduces datatypes for typeclass-constrained effects,                      as an alternative to monad-transformer based (datatype-constrained)@@ -14,7 +14,7 @@ Homepage:            https://github.com/RobotGymnast/extensible-effects Maintainer:          benjamin.foppa@gmail.com License:             MIT-Tested-With:         GHC==7.6.3+Tested-With:         GHC==7.8.2 Build-Type:          Simple Cabal-Version:       >= 1.9.2 @@ -36,12 +36,12 @@                        Control.Eff.Writer.Lazy                        Control.Eff.Writer.Strict                        Control.Eff.Trace-    other-modules:     Data.OpenUnion1+                       Data.OpenUnion1      build-depends:                      base >= 4.6 && < 5                     -- For MonadIO instance-                  , transformers == 0.3.0.*+                  , transformers >= 0.3 && < 0.5                     -- For MonadBase instance                   , transformers-base == 0.4.1.* @@ -50,7 +50,7 @@   main-is: Test.hs   hs-source-dirs: test/ -  ghc-options: -rtsopts=all -threaded+  ghc-options: -Wall    build-depends:     base >= 4.6 && < 5,

@@ -63,7 +63,7 @@ -- > lastAndSum l = let (lst, (total, ())) = run $ runWriter $ runState 0 $ writeAndAdd l -- >                in (lst, total) module Control.Eff(-                    Eff+                    Eff (..)                   , VE (..)                   , Member                   , SetMember@@ -93,10 +93,10 @@ -- | A `VE` is either a value, or an effect of type @`Union` r@ producing another `VE`. -- The result is that a `VE` can produce an arbitrarily long chain of @`Union` r@ -- effects, terminated with a pure value.-data VE w r = Val w | E !(Union r (VE w r))+data VE r w = Val w | E !(Union r (VE r w))   deriving Typeable -fromVal :: VE w r -> w+fromVal :: VE r w -> w fromVal (Val w) = w fromVal _ = error "extensible-effects: fromVal was called on a non-terminal effect." {-# INLINE fromVal #-}@@ -104,7 +104,7 @@ -- | Basic datatype returned by all computations with extensible effects. -- The type @r@ is the type of effects that can be handled, -- and @a@ is the type of value that is returned.-newtype Eff r a = Eff { runEff :: forall w. (a -> VE w r) -> VE w r }+newtype Eff r a = Eff { runEff :: forall w. (a -> VE r w) -> VE r w }   deriving Typeable  instance Functor (Eff r) where@@ -124,13 +124,13 @@  -- | Given a method of turning requests into results, -- we produce an effectful computation.-send :: (forall w. (a -> VE w r) -> Union r (VE w r)) -> Eff r a+send :: (forall w. (a -> VE r w) -> Union r (VE r w)) -> Eff r a send f = Eff (E . f) {-# INLINE send #-}  -- | Tell an effectful computation that you're ready to start running effects -- and return a value.-admin :: Eff r w -> VE w r+admin :: Eff r w -> VE r w admin (Eff m) = m Val {-# INLINE admin #-} 

@@ -18,7 +18,7 @@  -- | Nondeterministic choice data Choose v = forall a. Choose [a] (a -> v)-              deriving (Typeable)+    deriving (Typeable)  instance Functor Choose where     fmap f (Choose lst k) = Choose lst (f . k)@@ -43,7 +43,7 @@   loop (Val x)  = return [x]   loop (E u)    = handleRelay u loop (\(Choose lst k) -> handle lst k) -  handle :: [t] -> (t -> VE a (Choose :> r)) -> Eff r [a]+  handle :: [t] -> (t -> VE (Choose :> r) a) -> Eff r [a]   handle [] _  = return []   handle [x] k = loop (k x)   handle lst k = concat <$> mapM (loop . k) lst

@@ -3,7 +3,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} -- | Coroutines implemented with extensible effects-module Control.Eff.Coroutine( Yield+module Control.Eff.Coroutine( Yield (..)                             , yield                             , runC                             , Y (..)

@@ -40,7 +40,7 @@ -- We use exceptions for cutfalse -- Therefore, the law @cutfalse >>= k = cutfalse@ -- is satisfied automatically since all exceptions have the above property.-module Control.Eff.Cut( CutFalse+module Control.Eff.Cut( CutFalse (..)                       , call                       , cutfalse                       ) where

@@ -4,7 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} -- | Exception-producing and exception-handling effects-module Control.Eff.Exception( Exc(..)+module Control.Eff.Exception( Exc (..)                             , Fail                             , throwExc                             , die@@ -92,7 +92,7 @@ {-# INLINE liftEither #-}  -- | `liftEither` in a lifted Monad-liftEitherM :: (Typeable1 m, Typeable e, Member (Exc e) r, Member (Lift m) r)+liftEitherM :: (Typeable1 m, Typeable e, Member (Exc e) r, SetMember Lift (Lift m) r)             => m (Either e a)             -> Eff r a liftEitherM m = lift m >>= liftEither

@@ -4,7 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | Create unique Enumerable values.-module Control.Eff.Fresh( Fresh+module Control.Eff.Fresh( Fresh (..)                         , fresh                         , runFresh                         ) where

@@ -5,14 +5,13 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS -fno-warn-orphans #-} -- | Lifting primitive Monad types to effectful computations. -- We only allow a single Lifted Monad because Monads aren't commutative -- (e.g. Maybe (IO a) is functionally distinct from IO (Maybe a)).-module Control.Eff.Lift( Lift+module Control.Eff.Lift( Lift (..)                        , lift                        , runLift                        ) where@@ -38,26 +37,25 @@ #endif  instance SetMember Lift (Lift m) (Lift m :> ())-instance Member (Lift m) r => SetMember Lift (Lift m) r  instance Functor (Lift m) where     fmap f (Lift m k) = Lift m (f . k)     {-# INLINE fmap #-} -instance (Typeable1 m, MonadIO m, Member (Lift m) r) => MonadIO (Eff r) where-    liftIO = (lift :: m a -> Eff r a) . liftIO+instance (Typeable1 m, MonadIO m, SetMember Lift (Lift m) r) => MonadIO (Eff r) where+    liftIO = lift . liftIO     {-# INLINE liftIO #-} -instance (MonadBase b m, Typeable1 m, Member (Lift m) r) => MonadBase b (Eff r) where-    liftBase = (lift :: m a -> Eff r a) . liftBase+instance (MonadBase b m, Typeable1 m, SetMember Lift (Lift m) r) => MonadBase b (Eff r) where+    liftBase = lift . liftBase     {-# INLINE liftBase #-} --- | Lift a Monad to an Effect. We only allow a single lifted Monad.+-- | Lift a Monad to an Effect. lift :: (Typeable1 m, SetMember Lift (Lift m) r) => m a -> Eff r a lift m = send (inj . Lift m) --- | The handler of Lift requests. It is a terminal handler:--- use `runLift` in place of `run`.+-- | The handler of Lift requests. It is meant to be terminal:+-- we only allow a single Lifted Monad. runLift :: (Monad m, Typeable1 m) => Eff (Lift m :> ()) w -> m w runLift m = loop (admin m) where  loop (Val x) = return x

@@ -4,7 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | Lazy read-only state-module Control.Eff.Reader.Lazy( Reader+module Control.Eff.Reader.Lazy( Reader (..)                               , ask                               , local                               , reader

@@ -5,7 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | Strict read-only state-module Control.Eff.Reader.Strict( Reader+module Control.Eff.Reader.Strict( Reader (..)                                 , ask                                 , local                                 , reader

@@ -5,7 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | Lazy state effect-module Control.Eff.State.Lazy( State+module Control.Eff.State.Lazy( State (..)                              , get                              , put                              , modify

@@ -18,7 +18,7 @@ -- >                       put (n + 1) -- >                       loop (k n) -- >     Left u' -> send (\k -> unsafeReUnion $ k <$> u') >>= loop-module Control.Eff.State.Strict( State+module Control.Eff.State.Strict( State (..)                                , get                                , put                                , modify

@@ -3,7 +3,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} -- | A Trace effect for debugging-module Control.Eff.Trace( Trace+module Control.Eff.Trace( Trace (..)                         , trace                         , runTrace                         ) where

@@ -4,7 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | Lazy write-only state.-module Control.Eff.Writer.Lazy( Writer+module Control.Eff.Writer.Lazy( Writer (..)                               , tell                               , censor                               , runWriter

@@ -5,7 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} -- | Strict write-only state.-module Control.Eff.Writer.Strict( Writer+module Control.Eff.Writer.Strict( Writer (..)                                 , tell                                 , censor                                 , runWriter

@@ -8,7 +8,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE CPP #-}  #if MIN_VERSION_base(4,7,0)@@ -18,7 +17,7 @@ -- Open unions (type-indexed co-products) for extensible effects. -- This implementation relies on _closed_ overlapping instances -- (or closed type function overlapping soon to be added to GHC).-module Data.OpenUnion1( Union+module Data.OpenUnion1( Union (..)                       , SetMember                       , Member                       , (:>)

@@ -1,10 +1,11 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}-import Control.Exception (Exception, ErrorCall, catch)-import Control.Monad (void)+{-# LANGUAGE CPP #-}+{-# OPTIONS -fno-warn-missing-signatures #-}+import Control.Exception (ErrorCall, catch) import Data.Typeable -import Test.Framework (defaultMain, testGroup)+import Test.Framework (defaultMain) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 @@ -63,9 +64,9 @@     writeAndAdd :: (Member (LazyW.Writer Integer) e, Member (LazyS.State Integer) e)                 => [Integer]                 -> Eff e ()-    writeAndAdd l = do-        writeAll l-        sumAll l+    writeAndAdd lst = do+        writeAll lst+        sumAll lst  testCensor :: [Integer] -> Property testCensor l = property@@ -142,17 +143,25 @@         StrictW.tell (1 :: Int)         StrictW.tell (2 :: Int)         StrictW.tell (3 :: Int)-        die+        () <- die         StrictW.tell (4 :: Int)         return 5    in assertEqual "Fail should stop writing" 6 ret +#if MIN_VERSION_base(4,7,0)+#define Typeable1 Typeable+#endif+ -- | Ensure that https://github.com/RobotGymnast/extensible-effects/issues/11 stays resolved. testLift :: Assertion-testLift = runLift (lift $ return () :: Eff (Lift IO :> ()) ())+testLift = runLift possiblyAmbiguous+  where+    possiblyAmbiguous :: (Typeable1 m, Monad m, SetMember Lift (Lift m) r) => Eff r ()+    possiblyAmbiguous = lift $ return ()  tests =   [ testProperty "Documentation example." testDocs+  , testProperty "Test Writer.Lazy.censor." testCensor   , testCase "Test runReader laziness." testReaderLaziness   , testCase "Test runReader strictness." testReaderStrictness   , testCase "Test runState laziness." testStateLaziness@@ -161,4 +170,5 @@   , testCase "Test runLastWriter strictness." testLastWriterStrictness   , testCase "Test runFirstWriter laziness." testFirstWriterLaziness   , testCase "Test failure effect." testFailure+  , testCase "Test lift building." testLift   ]