extensible-effects 2.3.0.1 → 2.4.0.0

raw patch · 16 files changed

+195/−99 lines, 16 filesdep +silentlydep −directorydep ~HUnitdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: silently

Dependencies removed: directory

Dependency ranges changed: HUnit, QuickCheck, base

API changes (from Hackage documentation)

Files

• benchmark/Benchmarks.hs +25/−14
• extensible-effects.cabal +59/−7
• src/Control/Eff/Coroutine.hs +4/−3
• src/Control/Eff/Cut.hs +3/−1
• src/Control/Eff/Example.hs +10/−0
• src/Control/Eff/Operational.hs +7/−5
• src/Control/Eff/Reader/Lazy.hs +20/−12
• src/Control/Eff/Reader/Strict.hs +18/−9
• src/Control/Eff/State/Lazy.hs +2/−2
• src/Control/Eff/State/Strict.hs +2/−2
• src/Control/Eff/Writer/Lazy.hs +8/−5
• src/Control/Eff/Writer/Strict.hs +8/−5
• src/Data/OpenUnion.hs +13/−19
• test/Control/Eff/Example/Test.hs +9/−0
• test/Control/Eff/Exception/Test.hs +3/−0
• test/Utils.hs +4/−15

@@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  -- The simplest/silliest of all benchmarks! @@ -13,11 +15,17 @@ -- We use a strict State monad, because of large space leaks with the -- lazy monad (one test even overflows the stack) import Control.Monad.State.Strict as S-import Control.Monad.Error  as Er+import Control.Monad.Except  as Er -- import Control.Monad.Reader as Rd import Control.Monad.Cont as Ct import Control.Applicative +-- For sanity-checking+import qualified Test.Framework as TF+import qualified Test.Framework.TH as TF.TH+import Test.Framework.Providers.HUnit (testCase)+import qualified Test.HUnit as HU+ main :: IO () main = defaultMain [   bgroup "state" [ bgroup "10k" [ bench "mtl" $ whnf benchCnt_State 10000@@ -43,6 +51,9 @@                                        ]                   ]   ]+  >> TF.defaultMainWithArgs [ $(TF.TH.testGroupGenerator) ] testOpts+  where+    testOpts = [ "--color" ]  -- ------------------------------------------------------------------------ -- Single State, with very little non-effectful computation@@ -76,8 +87,6 @@ be_make_list :: Int -> [Int] be_make_list n = replicate n 1 ++ [0] -instance Error Int where- benchMul_Error :: Int -> Int benchMul_Error n = either id id m  where@@ -105,7 +114,7 @@                             return $! max acc x  f acc x = return $! max acc x -mainMax_MTL n = S.runState (Er.runErrorT (benchMax_MTL n)) 0+mainMax_MTL n = S.runState (Er.runExceptT (benchMax_MTL n)) 0  -- Different order of layers mainMax1_MTL n = (S.runStateT (benchMax_MTL n) 0 :: Either Int (Int,Int))@@ -147,9 +156,11 @@   [(3,4,5),(4,3,5),(5,12,13),(6,8,10),(8,6,10),(8,15,17),(9,12,15),(12,5,13),    (12,9,15),(12,16,20),(15,8,17),(16,12,20)] -pythr_MTL = pyth20 == ((runCont (pyth1 20) (\x -> [x])) :: [(Int,Int,Int)]) -pythr_EFF = pyth20 == ((run . E.ND.makeChoiceA $ pyth1 20) :: [(Int,Int,Int)])+case_pythr_ndet :: HU.Assertion+case_pythr_ndet =+  HU.assertEqual "pythr_MTL" pyth20 ((runCont (pyth1 20) (\x -> [x])) :: [(Int,Int,Int)])+  >> HU.assertEqual "pythr_EFF" pyth20 ((run . E.ND.makeChoiceA $ pyth1 20) :: [(Int,Int,Int)])   -- There is no instance of MonadPlus for ContT@@ -179,9 +190,6 @@   S.put $! (cnt + 1)   if x*x + y*y == z*z then return (x,y,z) else mzero -pythrNS_MTL :: ([(Int,Int,Int)],Int)-pythrNS_MTL = S.runState (runContT (pyth2 20) (\x -> return [x])) 0- pyth2E :: (Member (E.S.State Int) r, Member NdetEff r) =>           Int -> Eff r (Int, Int, Int) pyth2E upbound = do@@ -193,13 +201,16 @@   if x*x + y*y == z*z then return (x,y,z) else mzero  -pyth2Er :: ([(Int,Int,Int)],Int)-pyth2Er = run . (`E.S.runState` 0) . E.ND.makeChoiceA $ pyth2E 20- mainNS_MTL n =-  let (l,cnt) = S.runState (runContT (pyth2 n) (\x -> return [x])) 0+  let (l,cnt) = pythrNS_MTL n   in ((l::[(Int,Int,Int)]), (cnt::Int))+  where+    pythrNS_MTL :: Int -> ([(Int,Int,Int)],Int)+    pythrNS_MTL n = S.runState (runContT (pyth2 n) (\x -> return [x])) 0  mainNS_Eff n =-  let (l,cnt) = run . (`E.S.runState` 0) . E.ND.makeChoiceA $ pyth2E n+  let (l,cnt) = pyth2Er n   in ((l::[(Int,Int,Int)]), (cnt::Int))+  where+    pyth2Er :: Int -> ([(Int,Int,Int)],Int)+    pyth2Er n = run . (`E.S.runState` 0) . E.ND.makeChoiceA $ pyth2E n

@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             2.3.0.1+version:             2.4.0.0  -- A short (one-line) description of the package. synopsis:            An Alternative to Monad Transformers@@ -92,6 +92,18 @@   if flag(force-openunion-51)     cpp-options:       -DFORCE_OU51 +  default-extensions:  NoMonomorphismRestriction+                     , MonoLocalBinds+                     , FlexibleContexts+                     , FlexibleInstances+                     , GADTs+                     , MultiParamTypeClasses+                     , RankNTypes+                     , ScopedTypeVariables+                     , DataKinds+                     , TypeOperators+                     , PolyKinds+                     , KindSignatures   -- LANGUAGE extensions used by modules in this package.   other-extensions:    BangPatterns                        , CPP@@ -121,7 +133,7 @@      ghc-options:      -Wno-simplifiable-class-constraints    -- Other library packages from which modules are imported.-  build-depends:       base >= 4.6 && < 5+  build-depends:       base >= 4.7 && < 4.11                        -- For MonadIO instance                        , transformers >= 0.3 && < 0.6                        -- For MonadBase instance@@ -163,32 +175,72 @@                 , Control.Eff.Writer.Strict.Test    ghc-options: -Wall+  if impl(ghc >= 8.0)+     ghc-options:      -Wno-type-defaults -Wno-missing-signatures -Wno-name-shadowing+  if impl(ghc < 8.0)+     ghc-options:      -fno-warn-type-defaults -fno-warn-missing-signatures -fno-warn-name-shadowing    build-depends:-                base >= 4.6 && < 5-              , QuickCheck == 2.*-              , HUnit >= 1.2 && < 1.5+                base >= 4.7 && < 4.11+              , QuickCheck+              , HUnit+              , silently >= 1.2               , test-framework == 0.8.*               , test-framework-hunit == 0.3.*               , test-framework-quickcheck2 == 0.3.*               , test-framework-th >= 0.2               , extensible-effects-              , directory >= 1.2 && < 1.4    default-language:    Haskell2010+  default-extensions:  NoMonomorphismRestriction+                     , MonoLocalBinds+                     , FlexibleContexts+                     , FlexibleInstances+                     , GADTs+                     , MultiParamTypeClasses+                     , RankNTypes+                     , ScopedTypeVariables+                     , DataKinds+                     , TypeOperators+                     , PolyKinds+                     , KindSignatures  benchmark extensible-effects-benchmarks   type: exitcode-stdio-1.0   main-is: Benchmarks.hs   hs-source-dirs: benchmark/   ghc-options: -Wall -O2 -threaded -fdicts-cheap -funbox-strict-fields+  if impl(ghc >= 8.0)+     ghc-options:      -Wno-type-defaults -Wno-missing-signatures+                       -Wno-name-shadowing -Wno-unused-matches+  if impl(ghc < 8.0)+     ghc-options:      -fno-warn-type-defaults -fno-warn-missing-signatures+                       -fno-warn-name-shadowing -fno-warn-unused-matches+   build-depends:-                base+                base >= 4.7 && < 4.11               , criterion               , extensible-effects               , mtl+              , HUnit+              , test-framework == 0.8.*+              , test-framework-hunit == 0.3.*+              , test-framework-quickcheck2 == 0.3.*+              , test-framework-th >= 0.2    default-language:    Haskell2010+  default-extensions:  NoMonomorphismRestriction+                     , MonoLocalBinds+                     , FlexibleContexts+                     , FlexibleInstances+                     , GADTs+                     , MultiParamTypeClasses+                     , RankNTypes+                     , ScopedTypeVariables+                     , DataKinds+                     , TypeOperators+                     , PolyKinds+                     , KindSignatures  source-repository head   type: git

@@ -18,11 +18,12 @@ -- -- | The yield request: reporting a value of type e and suspending -- the coroutine. Resuming with the value of type b-data Yield a b v = Yield a (b -> v)+data Yield a b v where+  Yield :: a -> Yield a b b  -- | Yield a value of type a and suspend the coroutine. yield :: (Member (Yield a b) r) => a -> Eff r b-yield x = send (Yield x id)+yield x = send (Yield x)  -- | Status of a thread: done or reporting the value of the type a --   (For simplicity, a co-routine reports a value but accepts unit)@@ -41,5 +42,5 @@ runC :: Eff (Yield a b ': r) w -> Eff r (Y r a b) runC m = handle_relay   (const $ return Done)-  (\(Yield a f) k -> return $ Y a (k . f))+  (\(Yield a) k -> return $ Y a k)    m

@@ -58,7 +58,7 @@ -- of its argument computation. When it encounteres a cutfalse request, it -- discards the remaining choicepoints.  It completely handles CutFalse effects -- but not non-determinism-call :: Member Choose r => Eff (Exc CutFalse ': r) a -> Eff r a+call :: forall a r. Member Choose r => Eff (Exc CutFalse ': r) a -> Eff r a call m = loop [] m where   loop :: Member Choose r        => [Eff (Exc CutFalse ': r) a]@@ -69,6 +69,8 @@     Right (Exc CutFalse) -> mzero'  -- drop jq (F2)     Left u0 -> check jq u0 q +  check :: forall b. [Eff (Exc CutFalse ': r) a]+        -> Union r b -> Arrs (Exc CutFalse ': r) b a -> Eff r a   check jq u _ | Just (Choose []) <- prj u  = next jq  -- (C1)   check jq u q | Just (Choose [x]) <- prj u = loop jq (q ^$ x)  -- (C3), optim   check jq u q | Just (Choose lst) <- prj u = next $ map (q ^$) lst ++ jq -- (C3)

@@ -9,6 +9,7 @@ import Control.Eff import Control.Eff.Exception +import Control.Eff.Reader.Lazy import Control.Eff.State.Lazy import Control.Eff.Writer.Lazy @@ -22,6 +23,15 @@ runErrBig = runError  -- }}}++-- | Multiple Reader effects+sum2 :: Member (Reader Int) r+     => Member (Reader Float) r+     => Eff r Float+sum2 = do+  v1 <- ask+  v2 <- ask+  return $ fromIntegral (v1 + (1 :: Int)) + (v2 + (2 :: Float))  -- | Write the elements of a list of numbers, in order. writeAll :: (Member (Writer a) e)

@@ -2,7 +2,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE CPP #-}@@ -22,17 +22,19 @@  -- | Lift values to an effect. -- You can think this is a generalization of @Lift@.-data Program instr v = forall a. Program (instr a) (a -> v)+data Program instr v where+  Singleton :: instr a -> Program instr a  -- | Lift a value to a monad. singleton :: (Member (Program instr) r) => instr a -> Eff r a-singleton instr = send $ (Program instr) id+singleton = send . Singleton  -- | Convert values using given interpreter to effects.-runProgram :: (forall x. f x -> Eff r x) -> Eff (Program f ': r) a -> Eff r a+runProgram :: forall f r a. (forall x. f x -> Eff r x) -> Eff (Program f ': r) a -> Eff r a runProgram advent = handle_relay return h   where-    h (Program instr v) k = advent instr >>= k . v+    h :: forall v. Program f v -> (v -> Eff r a) -> Eff r a+    h (Singleton instr) k = advent instr >>= k  -- $usage --

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Safe #-} -- | Lazy read-only state@@ -22,13 +23,19 @@ -- returned in response to a (Reader e a) request is not any a; -- we expect in reply the value of type 'e', the value from the -- environment. So, the return type is restricted: 'a ~ e'--- data Reader e v where---   Reader :: Reader e e---+data Reader e v where+  Reader :: Reader e e+-- ^ -- One can also define this as---    data Reader e v = (e ~ v) => Reader--- and even without GADTs, using explicit coercion as is done here.-newtype Reader e v = Reader (e->v)+--+-- @+-- data Reader e v = (e ~ v) => Reader+-- @+-- ^ without GADTs, using explicit coercion as is done here.+--+-- @+-- newtype Reader e v = Reader (e->v)+-- @ -- ^ In the latter case, when we make the request, we make it as Reader id. -- So, strictly speaking, GADTs are not really necessary. @@ -36,24 +43,25 @@ -- | Get the current value from a Reader. -- The signature is inferred (when using NoMonomorphismRestriction). ask :: (Member (Reader e) r) => Eff r e-ask = send $ Reader id+ask = send Reader  -- | The handler of Reader requests. The return type shows that all Reader -- requests are fully handled. runReader :: Eff (Reader e ': r) w -> e -> Eff r w runReader m e = handle_relay   return-  (\(Reader f) k -> k (f e))+  (\Reader k -> k e)   m  -- | Locally rebind the value in the dynamic environment This function is like a -- relay; it is both an admin for Reader requests, and a requestor of them.--- The underscore is used to disable name-shadowing warning. local :: forall e a r. Member (Reader e) r =>          (e -> e) -> Eff r a -> Eff r a-local _f m = do-  e <- reader _f-  let h (Reader _f) g = g (_f e)+local f m = do+  e <- reader f+  let+    h :: Reader e t -> (t -> Eff r b) -> Eff r b+    h Reader g = g e   interpose return h m  -- | Request the environment value using a transformation function.

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Safe #-} -- | Strict read-only state@@ -23,13 +24,19 @@ -- returned in response to a (Reader e a) request is not any a; -- we expect in reply the value of type 'e', the value from the -- environment. So, the return type is restricted: 'a ~ e'--- data Reader e v where---   Reader :: Reader e e---+data Reader e v where+  Reader :: Reader e e+-- ^ -- One can also define this as---    data Reader e v = (e ~ v) => Reader--- and even without GADTs, using explicit coercion as is done here.-newtype Reader e v = Reader (e->v)+--+-- @+-- data Reader e v = (e ~ v) => Reader+-- @+-- ^ without GADTs, using explicit coercion as is done here.+--+-- @+-- newtype Reader e v = Reader (e->v)+-- @ -- ^ In the latter case, when we make the request, we make it as Reader id. -- So, strictly speaking, GADTs are not really necessary. @@ -37,14 +44,14 @@ -- | Get the current value from a Reader. -- The signature is inferred (when using NoMonomorphismRestriction). ask :: (Member (Reader e) r) => Eff r e-ask = send $ Reader id+ask = send Reader  -- | The handler of Reader requests. The return type shows that all Reader -- requests are fully handled. runReader :: Eff (Reader e ': r) w -> e -> Eff r w runReader m !e = handle_relay   return-  (\(Reader f) k -> k (f e))+  (\Reader k -> k e)   m  -- | Locally rebind the value in the dynamic environment This function is like a@@ -53,7 +60,9 @@          (e -> e) -> Eff r a -> Eff r a local f m = do   e <- reader f-  let h (Reader f0) g = g (f0 e)+  let+    h :: Reader e t -> (t -> Eff r b) -> Eff r b+    h Reader g = g e   interpose return h m  -- | Request the environment value using a transformation function.

@@ -98,9 +98,9 @@    loop :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s)    loop s (Val x) = return (x,s)    loop s (E u0 q) = case decomp u0 of-     Right (Writer w v) -> k w v+     Right (Tell w) -> k w ()      Left  u  -> case decomp u of-       Right (Reader f) -> k s (f s)+       Right Reader -> k s s        Left u1 -> E u1 (singleK (k s))     where k x = qComp q (loop x) 

@@ -115,8 +115,8 @@    loop :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s)    loop s0 (Val x) = return (x,s0)    loop s0 (E u q) = case decomp u of-     Right (Writer w v) -> k w v+     Right (Tell w) -> k w ()      Left  u1  -> case decomp u1 of-       Right (Reader f) -> k s0 (f s0)+       Right Reader -> k s0 s0        Left u2 -> E u2 (singleK (k s0))     where k x = qComp q (loop x)

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Safe #-} -- | Lazy write-only state@@ -27,17 +28,19 @@ -- writer has no such constraints. If we write a |Writer|-like -- interpreter to accumulate the told values in a monoid, it will have -- the |Monoid w| constraint then-data Writer w v = Writer w v+data Writer w v where+  Tell :: w -> Writer w ()  -- | Write a new value. tell :: Member (Writer w) r => w -> Eff r ()-tell w = send $ Writer w ()+tell w = send $ Tell w  -- | Transform the state being produced. censor :: forall w a r. Member (Writer w) r => (w -> w) -> Eff r a -> Eff r a censor f = interpose return h   where-    h (Writer w v) k = tell (f w) >> k v+    h :: Writer w t -> (t -> Eff r b) -> Eff r b+    h (Tell w) k = tell (f w) >>= k   -- | Handle Writer requests, using a user-provided function to accumulate@@ -45,9 +48,9 @@ runWriter :: (w -> b -> b) -> b -> Eff (Writer w ': r) a -> Eff r (a, b) runWriter accum b = handle_relay   (\x -> return (x, b))-  (\(Writer w v) k -> k v >>= \(x, l) -> return (x, w `accum` l))+  (\(Tell w) k -> k () >>= \(x, l) -> return (x, w `accum` l))   -- the second arg to 'handle_relay' above is same as:-  -- (\(Writer w v) k -> second (accum w) `fmap` k v)+  -- (\(Tell w) k -> second (accum w) `fmap` k ())   -- where   --   second f (x, y) = (x, f y) 

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Safe #-} -- | Strict write-only state@@ -28,17 +29,19 @@ -- writer has no such constraints. If we write a |Writer|-like -- interpreter to accumulate the told values in a monoid, it will have -- the |Monoid w| constraint then-data Writer w v = Writer !w v+data Writer w v where+  Tell :: !w -> Writer w ()  -- | Write a new value. tell :: Member (Writer w) r => w -> Eff r ()-tell !w = send $ Writer w ()+tell !w = send $ Tell w  -- | Transform the state being produced. censor :: forall w a r. Member (Writer w) r => (w -> w) -> Eff r a -> Eff r a censor f = interpose return h   where-    h (Writer w v) k = tell (f w) >> k v+    h :: Writer w t -> (t -> Eff r b) -> Eff r b+    h (Tell w) k = tell (f w) >>= k   -- | Handle Writer requests, using a user-provided function to accumulate@@ -46,9 +49,9 @@ runWriter :: (w -> b -> b) -> b -> Eff (Writer w ': r) a -> Eff r (a, b) runWriter accum !b = handle_relay   (\x -> return (x, b))-  (\(Writer w v) k -> k v >>= \(x, l) -> return (x, w `accum` l))+  (\(Tell w) k -> k () >>= \(x, l) -> return (x, w `accum` l))   -- the second arg to 'handle_relay' above is same as:-  -- (\(Writer o) k -> second (accum o) `fmap` k ())+  -- (\(Tell w) k -> second (accum w) `fmap` k ())   -- where   --   second f (x, y) = (x, f y) 

@@ -10,12 +10,7 @@ {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -Wwarn #-} -#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -Wwarn -Wno-redundant-constraints #-}-#endif- #if __GLASGOW_HASKELL__ < 710 || FORCE_OU51-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE OverlappingInstances #-} #else #endif@@ -61,6 +56,9 @@                   ) where  import Unsafe.Coerce(unsafeCoerce)+#if __GLASGOW_HASKELL__ > 800+import GHC.TypeLits+#endif  -- | The data constructors of Union are not exported --@@ -117,7 +115,9 @@    {-# INLINE prj #-}    inj x           = Union 0 x    prj (Union _ x) = Just (unsafeCoerce x)-+-- Note that if it weren't for us wanting to use the specialized instance above+-- we wouldn't need the INCOHERENT pragma below+-- TODO: consider impact of disabling specialization instance {-# INCOHERENT #-}  (FindElem t r) => Member t r where   {-# INLINE inj #-}   {-# INLINE prj #-}@@ -125,14 +125,11 @@   prj = prj' (unP $ (elemNo :: P t r)) #endif -- {-# INLINE [2] decomp #-} decomp :: Union (t ': r) v -> Either (Union r v) (t v) decomp (Union 0 v) = Right $ unsafeCoerce v decomp (Union n v) = Left  $ Union (n-1) v - -- Specialized version {-# RULES "decomp/singleton"  decomp = decomp0 #-} {-# INLINE decomp0 #-}@@ -151,24 +148,21 @@ class FindElem (t :: * -> *) r where   elemNo :: P t r -#if !(__GLASGOW_HASKELL__ < 710 || FORCE_OU51)--- Stopped Using Obsolete -XOverlappingInstances--- and explicitly specify to choose the topmost--- one for multiple occurence, which is the same--- behaviour as OpenUnion51 with GHC 7.10.-instance {-# INCOHERENT #-} t ~ s => FindElem t '[s] where-  elemNo = P 0-#endif instance FindElem t (t ': r) where   elemNo = P 0- #if __GLASGOW_HASKELL__ < 710 || FORCE_OU51 instance FindElem t r => FindElem t (t' ': r) where #else instance {-# OVERLAPPABLE #-} FindElem t r => FindElem t (t' ': r) where #endif   elemNo = P $ 1 + (unP $ (elemNo :: P t r))-+#if __GLASGOW_HASKELL__ > 800+instance TypeError ('Text "Cannot unify effect types." ':$$:+                    'Text "Unhandled effect: " ':<>: 'ShowType t ':$$:+                    'Text "Perhaps check the type of effectful computation and the sequence of handlers for concordance?")+  => FindElem t '[] where+  elemNo = error "unreachable"+#endif  -- | Using overlapping instances here is OK since this class is private to this -- module

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, AllowAmbiguousTypes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Control.Eff.Example.Test (testGroups, ex2) where @@ -41,6 +42,14 @@ case_Exception1_ex2r2 = (Left (TooBig 7)) @=? (run ex2r2)   where     ex2r2 = runErrBig (runReader (ex2 ask) (7::Int))++case_multiple_eff_sum2 :: Assertion+case_multiple_eff_sum2 =+  assertEqual "Int : Float" 33 intThenFloat+  >> assertEqual "Float : Int" intThenFloat floatThenInt+  where+    intThenFloat = run $ runReader (runReader sum2 (10::Int)) (20::Float)+    floatThenInt = run $ runReader (runReader sum2 (20::Float)) (10::Int)  prop_Documentation_example :: [Integer] -> Property prop_Documentation_example l = let

@@ -2,6 +2,7 @@ {-# LANGUAGE TypeOperators, DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}  module Control.Eff.Exception.Test (testGroups) where @@ -9,7 +10,9 @@ import Control.Eff import Control.Eff.Exception import Control.Eff.Writer.Strict+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid+#endif import Utils  import Test.Framework.TH

@@ -5,26 +5,15 @@ import Control.Exception (ErrorCall, catch) import Control.Monad -import GHC.IO.Handle-import System.IO-import System.Directory+import System.IO.Silently+import Data.Tuple (swap)  import Test.HUnit hiding (State)  -- | capture stdout--- [[https://stackoverflow.com/a/9664017][source]]+-- [[https://stackoverflow.com/a/11128420][source]] catchOutput :: IO a -> IO (a, String)-catchOutput f = do-  tmpd <- getTemporaryDirectory-  (tmpf, tmph) <- openTempFile tmpd "haskell_stdout"-  stdout_dup <- hDuplicate stdout-  hDuplicateTo tmph stdout-  hClose tmph-  fVal <- f-  hDuplicateTo stdout_dup stdout-  str <- readFile tmpf-  removeFile tmpf-  return (fVal, str)+catchOutput f = swap `fmap` capture f  showLn :: Show a => a -> String showLn x = unlines $ [show x]