diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,5 +1,14 @@
 # Change log
 
+## 0.5
+
+* Allow `transformers-0.6`, see #47.
+* Drop dependencies on `mtl` and `tasty`. See #45, #46.
+* Derive the stock `Eq` and `Ord` instances for `Validation`, see #43.
+* Add `selectT`, see #42.
+* Add more general instances for `IdentityT` and `ReaderT`. This is technically
+  a breaking change because `Selective` is not a superclass of `Monad`. See #38.
+
 ## 0.4.1
 
 * Allow newer QuickCheck.
diff --git a/examples/Processor.hs b/examples/Processor.hs
--- a/examples/Processor.hs
+++ b/examples/Processor.hs
@@ -1,30 +1,42 @@
-{-# LANGUAGE ConstraintKinds, DeriveFunctor, GADTs, FlexibleContexts, LambdaCase #-}
+{-# LANGUAGE ConstraintKinds, DeriveFunctor, GADTs, LambdaCase #-}
+{-# LANGUAGE FunctionalDependencies, FlexibleContexts, FlexibleInstances #-}
+
 module Processor where
 
 import Control.Selective
 import Control.Selective.Rigid.Free
-import Data.Functor
 import Data.Bool
+import Data.Functor
 import Data.Int (Int16)
-import Data.Word (Word8)
 import Data.Map.Strict (Map)
+import Data.Word (Word8)
+import Foreign.Marshal.Utils (fromBool)
 import Prelude hiding (read, log)
 
-import qualified Control.Monad.State as S
-import qualified Data.Map.Strict     as Map
+import qualified Control.Monad.Trans.State as S
+import qualified Data.Map.Strict as Map
 
 -- See Section 5.3 of the paper:
 -- https://www.staff.ncl.ac.uk/andrey.mokhov/selective-functors.pdf
 -- Note that we have changed the naming.
 
--- | Hijack @mtl@'s 'MonadState' constraint to include Selective.
-type MonadState s m = (Selective m, S.MonadState s m)
+-- | A standard @MonadState@ class extended with the 'Selective' interface.
+class (Selective m, Monad m) => MonadState s m | m -> s where
+    get   :: m s
+    put   :: s -> m ()
+    state :: (s -> (a, s)) -> m a
 
--- | Convert a 'Bool' to @0@ or @1@.
-fromBool :: Num a => Bool -> a
-fromBool True  = 1
-fromBool False = 0
+instance Monad m => MonadState s (S.StateT s m) where
+    get   = S.get
+    put   = S.put
+    state = S.state
 
+gets :: MonadState s m => (s -> a) -> m a
+gets f = f <$> get
+
+modify :: MonadState s m => (s -> s) -> m ()
+modify f = state (\s -> ((), f s))
+
 --------------------------------------------------------------------------------
 -------- Types -----------------------------------------------------------------
 --------------------------------------------------------------------------------
@@ -94,16 +106,16 @@
     show (Write k _        _) = "Write " ++ show k
 
 logEntry :: MonadState State m => LogEntry Key Value -> m ()
-logEntry item = S.modify $ \s -> s { log = log s ++ [item] }
+logEntry item = modify $ \s -> s { log = log s ++ [item] }
 
 -- | Interpret the base functor in a 'MonadState'.
 toState :: MonadState State m => RW a -> m a
 toState = \case
     (Read k t) -> do
-        v <- case k of Reg  r    -> S.gets ((Map.! r) . registers)
-                       Cell addr -> S.gets ((Map.! addr) . memory)
-                       Flag f    -> S.gets ((Map.! f) . flags)
-                       PC        -> S.gets pc
+        v <- case k of Reg  r    -> gets ((Map.! r) . registers)
+                       Cell addr -> gets ((Map.! addr) . memory)
+                       Flag f    -> gets ((Map.! f) . flags)
+                       PC        -> gets pc
         logEntry (ReadEntry k v)
         pure (t v)
     (Write k p t) -> do
@@ -111,14 +123,14 @@
         logEntry (WriteEntry k v)
         case k of
             Reg r     -> let regs' s = Map.insert r v (registers s)
-                         in  S.state (\s -> (t v, s {registers = regs' s}))
+                         in  state (\s -> (t v, s {registers = regs' s}))
             Cell addr -> let mem' s = Map.insert addr v (memory s)
-                         in S.state (\s -> (t v, s {memory = mem' s}))
+                         in state (\s -> (t v, s {memory = mem' s}))
             Flag f    -> let flags' s = Map.insert f v (flags s)
-                         in S.state (\s -> (t v, s {flags = flags' s}))
-            PC        -> S.state (\s -> (t v, s {pc = v}))
+                         in state (\s -> (t v, s {flags = flags' s}))
+            PC        -> state (\s -> (t v, s {pc = v}))
 
--- | Interpret a program as a state trasformer.
+-- | Interpret a program as a state transformer.
 runProgramState :: Program a -> State -> (a, State)
 runProgramState f = S.runState (runSelect toState f)
 
diff --git a/examples/Query.hs b/examples/Query.hs
--- a/examples/Query.hs
+++ b/examples/Query.hs
@@ -14,7 +14,7 @@
     Select   :: Query (Either a b) -> Query (a -> b) -> Query b
 
 instance Functor Query where
-    fmap f x = Apply (Pure f) x
+    fmap f = Apply (Pure f)
 
 instance Applicative Query where
     pure  = Pure
diff --git a/selective.cabal b/selective.cabal
--- a/selective.cabal
+++ b/selective.cabal
@@ -1,5 +1,5 @@
 name:          selective
-version:       0.4.2
+version:       0.5
 synopsis:      Selective applicative functors
 license:       MIT
 license-file:  LICENSE
@@ -35,9 +35,9 @@
                         Control.Selective.Multi,
                         Control.Selective.Rigid.Free,
                         Control.Selective.Rigid.Freer
-    build-depends:      base         >= 4.7     && < 5,
+    build-depends:      base         >= 4.9     && < 5,
                         containers   >= 0.5.5.1 && < 0.7,
-                        transformers >= 0.4.2.0 && < 0.6
+                        transformers >= 0.4.2.0 && < 0.7
     default-language:   Haskell2010
     other-extensions:   DeriveFunctor,
                         FlexibleInstances,
@@ -52,6 +52,8 @@
                         -Wincomplete-record-updates
                         -Wincomplete-uni-patterns
                         -Wredundant-constraints
+    if impl(ghc >= 9.2)
+        ghc-options:    -Wno-operator-whitespace-ext-conflict
 
 test-suite test
     hs-source-dirs:     test, examples
@@ -63,18 +65,15 @@
                         Sketch,
                         Teletype,
                         Teletype.Rigid,
+                        Test,
                         Validation
     type:               exitcode-stdio-1.0
     main-is:            Main.hs
     build-depends:      base                   >= 4.7     && < 5,
                         containers             >= 0.5.5.1 && < 0.7,
-                        mtl                    >= 2.2.1   && < 2.3,
                         QuickCheck             >= 2.8     && < 2.15,
                         selective,
-                        tasty                  >= 0.11,
-                        tasty-expected-failure >= 0.11,
-                        tasty-quickcheck       >= 0.8.4,
-                        transformers           >= 0.4.2.0 && < 0.6
+                        transformers           >= 0.4.2.0 && < 0.7
     default-language:   Haskell2010
     ghc-options:        -Wall
                         -fno-warn-name-shadowing
@@ -82,3 +81,5 @@
                         -Wincomplete-record-updates
                         -Wincomplete-uni-patterns
                         -Wredundant-constraints
+    if impl(ghc >= 9.2)
+        ghc-options:    -Wno-operator-whitespace-ext-conflict
diff --git a/src/Control/Selective.hs b/src/Control/Selective.hs
--- a/src/Control/Selective.hs
+++ b/src/Control/Selective.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, LambdaCase, TupleSections, DeriveFunctor #-}
+{-# LANGUAGE CPP, LambdaCase, TupleSections, DeriveTraversable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
@@ -17,7 +17,7 @@
 -----------------------------------------------------------------------------
 module Control.Selective (
     -- * Type class
-    Selective (..), (<*?), branch, selectA, apS, selectM,
+    Selective (..), (<*?), branch, selectA, selectT, apS, selectM,
 
     -- * Conditional combinators
     ifS, whenS, fromMaybeS, orElse, andAlso, untilRight, whileS, (<||>), (<&&>),
@@ -197,6 +197,14 @@
 selectA :: Applicative f => f (Either a b) -> f (a -> b) -> f b
 selectA x y = (\e f -> either f id e) <$> x <*> y
 
+-- | If a functor is both 'Applicative' and 'Traversable', we can implement
+-- 'select' in another interesting way: the effects associated with the second
+-- argument can be skipped as long as the first argument contains only 'Right's.
+selectT :: (Applicative f, Traversable f) => f (Either a b) -> f (a -> b) -> f b
+selectT x y = case sequenceA x of
+    Left  a  -> ($a) <$> y
+    Right fb -> fb
+
 {-| Recover the application operator '<*>' from 'select'. /Rigid/ selective
 functors satisfy the law '<*>' @=@ 'apS' and furthermore, the resulting
 applicative functor satisfies all laws of 'Applicative':
@@ -394,17 +402,19 @@
     pure _            = Over mempty
     Over x <*> Over y = Over (mappend x y)
 
+-- select = selectA
 instance Monoid m => Selective (Over m) where
     select (Over x) (Over y) = Over (mappend x y)
 
 -- | Static analysis of selective functors with under-approximation.
 newtype Under m a = Under { getUnder :: m }
-    deriving (Eq, Functor, Ord, Show)
+    deriving (Eq, Functor, Ord, Show, Foldable, Traversable)
 
 instance Monoid m => Applicative (Under m) where
     pure _              = Under mempty
     Under x <*> Under y = Under (mappend x y)
 
+-- select = selectT
 instance Monoid m => Selective (Under m) where
     select (Under m) _ = Under m
 
@@ -419,7 +429,7 @@
 
 -- | Selective instance for the standard applicative functor Validation. This is
 -- a good example of a non-trivial selective functor which is not a monad.
-data Validation e a = Failure e | Success a deriving (Functor, Show)
+data Validation e a = Failure e | Success a deriving (Eq, Functor, Ord, Show)
 
 instance Semigroup e => Applicative (Validation e) where
     pure = Success
@@ -436,6 +446,27 @@
 instance (Selective f, Selective g) => Selective (Product f g) where
     select (Pair fx gx) (Pair fy gy) = Pair (select fx fy) (select gx gy)
 
+instance Selective f => Selective (IdentityT f) where
+    select (IdentityT x) (IdentityT y) = IdentityT (select x y)
+
+instance Selective f => Selective (ReaderT env f) where
+    select (ReaderT x) (ReaderT y) = ReaderT $ \env -> select (x env) (y env)
+
+distributeEither :: (Either a b, w) -> Either (a, w) (b, w)
+distributeEither (Left  a, w) = Left  (a, w)
+distributeEither (Right b, w) = Right (b, w)
+
+distributeFunction :: Monoid w => (a -> b, w) -> (a, w) -> (b, w)
+distributeFunction (f, wf) (x, wx) = (f x, mappend wx wf)
+
+instance (Monoid w, Selective f) => Selective (WriterT w f) where
+    select (WriterT x) (WriterT f) =
+        WriterT $ select (distributeEither <$> x) (distributeFunction <$> f)
+
+instance (Monoid w, Selective f) => Selective (S.WriterT w f) where
+    select (S.WriterT x) (S.WriterT f) =
+        S.WriterT $ select (distributeEither <$> x) (distributeFunction <$> f)
+
 -- TODO: Is this a useful instance? Note that composition of 'Alternative'
 -- requires @f@ to be 'Alternative', and @g@ to be 'Applicative', which is
 -- opposite to what we have here:
@@ -480,15 +511,11 @@
 
 instance                        Selective (ContT      r m) where select = selectM
 instance            Monad m  => Selective (ExceptT    e m) where select = selectM
-instance            Monad m  => Selective (IdentityT    m) where select = selectM
 instance            Monad m  => Selective (MaybeT       m) where select = selectM
-instance            Monad m  => Selective (ReaderT    r m) where select = selectM
 instance (Monoid w, Monad m) => Selective (RWST   r w s m) where select = selectM
 instance (Monoid w, Monad m) => Selective (S.RWST r w s m) where select = selectM
 instance            Monad m  => Selective (StateT     s m) where select = selectM
 instance            Monad m  => Selective (S.StateT   s m) where select = selectM
-instance (Monoid w, Monad m) => Selective (WriterT    w m) where select = selectM
-instance (Monoid w, Monad m) => Selective (S.WriterT  w m) where select = selectM
 
 ------------------------------------ Arrows ------------------------------------
 -- See the following standard definitions in "Control.Arrow".
diff --git a/src/Control/Selective/Rigid/Free.hs b/src/Control/Selective/Rigid/Free.hs
--- a/src/Control/Selective/Rigid/Free.hs
+++ b/src/Control/Selective/Rigid/Free.hs
@@ -69,9 +69,9 @@
     -- Associativity law
     select x (Select y z) = Select (select (f <$> x) (g <$> y)) (h <$> z)
       where
-        f x = Right <$> x
-        g y = \a -> bimap (,a) ($a) y
-        h z = uncurry z
+        f     = fmap Right
+        g y a = bimap (,a) ($a) y
+        h     = uncurry
 
 {- The following can be used in the above implementation as select = selectOpt.
 
diff --git a/test/Laws.hs b/test/Laws.hs
--- a/test/Laws.hs
+++ b/test/Laws.hs
@@ -1,14 +1,14 @@
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleInstances, TupleSections, TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Laws where
 
-import Test.QuickCheck hiding (Failure, Success)
-import Data.Bifunctor (bimap, first, second)
 import Control.Arrow hiding (first, second)
+import Control.Monad.Trans.Writer
 import Control.Selective
+import Data.Bifunctor (bimap, first, second)
 import Data.Function
 import Data.Functor.Identity
+import Test.QuickCheck hiding (Failure, Success)
 import Text.Show.Functions()
 
 -- | TODO:
@@ -27,72 +27,62 @@
 
 -- | Associativity
 lawAssociativity :: (Selective f, Eq (f c)) =>
-        f (Either b c) -> f (Either a (b -> c)) -> f (a -> b -> c) -> Bool
-lawAssociativity x y z = (x <*? (y <*? z)) == ((f <$> x) <*? (g <$> y) <*? (h <$> z))
-        where
-            f x = Right <$> x
-            g y = \a -> bimap (,a) ($a) y
-            h z = uncurry z
+    f (Either b c) -> f (Either a (b -> c)) -> f (a -> b -> c) -> Bool
+lawAssociativity x y z =
+    (x <*? (y <*? z)) == ((f <$> x) <*? (g <$> y) <*? (h <$> z))
+  where
+    f     = fmap Right
+    g y a = bimap (,a) ($a) y
+    h     = uncurry
 
 {- | If 'f' is a 'Monad' |-}
 
-lawMonad :: (Selective f, Monad f, Eq (f b)) =>
-            f (Either a b) -> f (a -> b) -> Bool
+lawMonad :: (Selective f, Monad f, Eq (f b)) => f (Either a b) -> f (a -> b) -> Bool
 lawMonad x f = select x f == selectM x f
 
-selectALaw :: (Selective f, Eq (f b)) =>
-              f (Either a b) -> f (a -> b) -> Bool
+selectALaw :: (Selective f, Eq (f b)) => f (Either a b) -> f (a -> b) -> Bool
 selectALaw x f = select x f == selectA x f
 
 --------------------------------------------------------------------------------
 ------------------------ Theorems ----------------------------------------------
 --------------------------------------------------------------------------------
-{-| Theorems about selective applicative functors,
-    as presented in the Fig.4 of the paper
-|-}
+{-| Theorems about selective applicative functors, see Fig. 4 of the paper |-}
 
 -- | Apply a pure function to the result:
-theorem1 :: (Selective f, Eq (f c)) =>
-            (a -> c) -> f (Either b a) -> f (b -> a) -> Bool
+theorem1 :: (Selective f, Eq (f c)) => (a -> c) -> f (Either b a) -> f (b -> a) -> Bool
 theorem1 f x y = (f <$> select x y) == select (second f <$> x) ((f .) <$> y)
 
 -- | Apply a pure function to the Left case of the first argument:
-theorem2 :: (Selective f, Eq (f c)) =>
-            (a -> b) -> f (Either a c) -> f (b -> c) -> Bool
+theorem2 :: (Selective f, Eq (f c)) => (a -> b) -> f (Either a c) -> f (b -> c) -> Bool
 theorem2 f x y = select (first f <$> x) y == select x ((. f) <$> y)
 
 -- | Apply a pure function to the second argument:
-theorem3 :: (Selective f, Eq (f c)) =>
-            (a -> b -> c) -> f (Either b c) -> f a -> Bool
+theorem3 :: (Selective f, Eq (f c)) => (a -> b -> c) -> f (Either b c) -> f a -> Bool
 theorem3 f x y = select x (f <$> y) == select (first (flip f) <$> x) ((&) <$> y)
 
 -- | Generalised identity:
 theorem4 :: (Selective f, Eq (f b)) => f (Either a b) -> (a -> b) -> Bool
 theorem4 x y = (x <*? pure y) == (either y id <$> x)
 
-{-| For rigid selective functors (in particular, for monads):
-|-}
+{-| For rigid selective functors (in particular, for monads) |-}
 
 -- | Selective apply
 theorem5 :: (Selective f, Eq (f b)) => f (a -> b) -> f a -> Bool
 theorem5 f g = (f <*> g) == (f `apS` g)
 
 -- | Interchange
-theorem6 :: (Selective f, Eq (f c)) =>
-            f a -> f (Either b c) -> f (b -> c) -> Bool
+theorem6 :: (Selective f, Eq (f c)) => f a -> f (Either b c) -> f (b -> c) -> Bool
 theorem6 x y z = (x *> (y <*? z)) == ((x *> y) <*? z)
 
 --------------------------------------------------------------------------------
 ------------------------ Properties ----------------------------------------------
 --------------------------------------------------------------------------------
 
--- | pure-right
---   pure (Right x) <*? y = pure x
+-- | Pure-Right: pure (Right x) <*? y = pure x
 propertyPureRight :: (Selective f, Eq (f a)) => a -> f (b -> a) -> Bool
 propertyPureRight x y = (pure (Right x) <*? y) == pure x
 
--- | pure-left
---   pure (Left x) <*? y = ($x) <$> y
+-- | Pure-Left: pure (Left x) <*? y = ($x) <$> y
 propertyPureLeft :: (Selective f, Eq (f b)) => a -> f (a -> b) -> Bool
 propertyPureLeft x y = (pure (Left x) <*? y) == (($x) <$> y)
 
@@ -119,24 +109,22 @@
 --------------------------------------------------------------------------------
 ------------------------ Validation --------------------------------------------
 --------------------------------------------------------------------------------
-deriving instance (Eq e, Eq a) => Eq (Validation e a)
-
 instance (Arbitrary e, Arbitrary a) => Arbitrary (Validation e a) where
-  arbitrary = oneof [Failure <$> arbitrary, Success <$> arbitrary]
-  shrink (Failure x) = [ Failure x' | x' <- shrink x ]
-  shrink (Success y) = [ Success y' | y' <- shrink y ]
+    arbitrary = oneof [Failure <$> arbitrary, Success <$> arbitrary]
+    shrink (Failure x) = [ Failure x' | x' <- shrink x ]
+    shrink (Success y) = [ Success y' | y' <- shrink y ]
 
 --------------------------------------------------------------------------------
 ------------------------ ArrowMonad --------------------------------------------
 --------------------------------------------------------------------------------
 instance Eq a => Eq (ArrowMonad (->) a) where
-  ArrowMonad f == ArrowMonad g = f () == g ()
+    ArrowMonad f == ArrowMonad g = f () == g ()
 
 instance Arbitrary a => Arbitrary (ArrowMonad (->) a) where
-  arbitrary = ArrowMonad . const <$> arbitrary
+    arbitrary = ArrowMonad . const <$> arbitrary
 
 instance Show a => Show (ArrowMonad (->) a) where
-  show (ArrowMonad f) = show (f ())
+    show (ArrowMonad f) = show (f ())
 --------------------------------------------------------------------------------
 ------------------------ Maybe -------------------------------------------------
 --------------------------------------------------------------------------------
@@ -150,3 +138,11 @@
 
 propertyPureRightIdentity :: IO ()
 propertyPureRightIdentity = quickCheck (propertyPureRight @Identity @Int @Int)
+
+
+--------------------------------------------------------------------------------
+------------------------ Writer ------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance (Arbitrary w, Arbitrary a) => Arbitrary (Writer w a) where
+    arbitrary = curry writer <$> arbitrary <*> arbitrary
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,318 +1,388 @@
 {-# LANGUAGE TypeApplications #-}
 
 import Control.Arrow (ArrowMonad)
+import Control.Monad.Trans.Writer hiding (writer)
 import Control.Selective
 import Data.Functor.Identity
 import Data.Maybe hiding (maybe)
 import Prelude hiding (maybe)
-import Test.Tasty
-import Test.Tasty.QuickCheck hiding (Success, Failure)
-import Test.Tasty.ExpectedFailure
 
 import Build
 import Laws
 import Validation
 
+import Test
+
 import qualified Control.Selective.Free       as F
 import qualified Control.Selective.Rigid.Free as FR
 import qualified Teletype                     as F
 import qualified Teletype.Rigid               as FR
 
 main :: IO ()
-main = defaultMain $ testGroup "Tests"
-    [pingPong, build, over, under, validation, arrowMonad, maybe, identity]
+main = runTests $ testGroup "Tests"
+    [ pingPong
+    , build
+    , over
+    , under
+    , validation
+    , arrowMonad
+    , maybe
+    , identity
+    , writer ]
 
 --------------------------------------------------------------------------------
 ------------------------ Ping-pong----------------------------------------------
 --------------------------------------------------------------------------------
-pingPong :: TestTree
+pingPong :: Tests
 pingPong = testGroup "pingPong"
-    [ testProperty "Free.getEffects pingPongS == [Read,Write \"pong\"]" $
-       F.getEffects F.pingPongS == [F.Read (const ()),F.Write "pong" ()]
-    , testProperty "Free.getNecessaryEffects pingPongS == [Read]" $
-       F.getNecessaryEffects F.pingPongS == [F.Read (const ())]
-    , testProperty "Free.Rigid.getEffects pingPongS == [Read,Write \"pong\"]" $
-       FR.getEffects FR.pingPongS == [FR.Read (const ()),FR.Write "pong" ()] ]
+    [ expectSuccess "Free.getEffects pingPongS == [Read,Write \"pong\"]" $
+        F.getEffects F.pingPongS == [F.Read (const ()),F.Write "pong" ()]
+    , expectSuccess "Free.getNecessaryEffects pingPongS == [Read]" $
+        F.getNecessaryEffects F.pingPongS == [F.Read (const ())]
+    , expectSuccess "Free.Rigid.getEffects pingPongS == [Read,Write \"pong\"]" $
+        FR.getEffects FR.pingPongS == [FR.Read (const ()),FR.Write "pong" ()] ]
 
 --------------------------------------------------------------------------------
 ------------------------ Build -------------------------------------------------
 --------------------------------------------------------------------------------
-build :: TestTree
-build = testGroup "Build" [cyclicDeps, taskBindDeps, runBuildDeps]
+build :: Tests
+build = testGroup "Build"
+    [ cyclicDeps
+    , taskBindDeps
+    , runBuildDeps ]
 
-cyclicDeps :: TestTree
+cyclicDeps :: Tests
 cyclicDeps = testGroup "cyclicDeps"
-    [ testProperty "dependenciesOver (fromJust $ cyclic \"B1\") == [\"C1\",\"B2\",\"A2\"]" $
-       dependenciesOver (fromJust $ cyclic "B1") == ["C1","B2","A2"]
-    , testProperty "dependenciesOver cyclic \"B2\") == [\"C1\",\"A1\",\"B1\"]" $
+    [ expectSuccess "dependenciesOver (fromJust $ cyclic \"B1\") == [\"C1\",\"B2\",\"A2\"]" $
+        dependenciesOver (fromJust $ cyclic "B1") == ["C1","B2","A2"]
+    , expectSuccess "dependenciesOver cyclic \"B2\") == [\"C1\",\"A1\",\"B1\"]" $
         dependenciesOver (fromJust $ cyclic "B2") == ["C1","A1","B1"]
-    , testProperty "dependenciesUnder (fromJust $ cyclic \"B1\") == [\"C1\"]" $
-       dependenciesUnder (fromJust $ cyclic "B1") == ["C1"]
-    , testProperty "dependenciesUnder cyclic \"B2\") == [\"C1\"]" $
+    , expectSuccess "dependenciesUnder (fromJust $ cyclic \"B1\") == [\"C1\"]" $
+        dependenciesUnder (fromJust $ cyclic "B1") == ["C1"]
+    , expectSuccess "dependenciesUnder cyclic \"B2\") == [\"C1\"]" $
         dependenciesUnder (fromJust $ cyclic "B2") == ["C1"] ]
 
-taskBindDeps :: TestTree
+taskBindDeps :: Tests
 taskBindDeps = testGroup "taskBindDeps"
-    [ testProperty "dependenciesOver taskBind == [\"A1\",\"A2\",\"C5\",\"C6\",\"A2\",\"D5\",\"D6\"]" $
-       dependenciesOver taskBind == ["A1","A2","C5","C6","A2","D5","D6"]
-    , testProperty "dependenciesUnder taskBind == [\"A1\"]" $
-       dependenciesUnder taskBind == ["A1"] ]
+    [ expectSuccess "dependenciesOver taskBind == [\"A1\",\"A2\",\"C5\",\"C6\",\"A2\",\"D5\",\"D6\"]" $
+        dependenciesOver taskBind == ["A1","A2","C5","C6","A2","D5","D6"]
+    , expectSuccess "dependenciesUnder taskBind == [\"A1\"]" $
+        dependenciesUnder taskBind == ["A1"] ]
 
-runBuildDeps :: TestTree
+runBuildDeps :: Tests
 runBuildDeps = testGroup "runBuildDeps"
-    [ testProperty "runBuild (fromJust $ cyclic \"B1\") == [Fetch \"C1\",Fetch \"B2\",Fetch \"A2\"]" $
-       runBuild (fromJust $ cyclic "B1") == [Fetch "C1" (const ()),Fetch "B2" (const ()),Fetch "A2" (const ())] ]
+    [ expectSuccess "runBuild (fromJust $ cyclic \"B1\") == [Fetch \"C1\",Fetch \"B2\",Fetch \"A2\"]" $
+        runBuild (fromJust $ cyclic "B1") == [Fetch "C1" (const ()),Fetch "B2" (const ()),Fetch "A2" (const ())] ]
 
 --------------------------------------------------------------------------------
 ------------------------ Over --------------------------------------------------
 --------------------------------------------------------------------------------
-over :: TestTree
-over = testGroup "Over" [overLaws, overTheorems, overProperties]
+over :: Tests
+over = testGroup "Over"
+    [ overLaws
+    , overTheorems
+    , overProperties ]
 
-overLaws :: TestTree
+overLaws :: Tests
 overLaws = testGroup "Laws"
-    [ testProperty "Identity: (x <*? pure id) == (either id id <$> x)" $
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
         \x -> lawIdentity @(Over String) x
-    , testProperty "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
         \x -> lawDistributivity @(Over String) @Int @Int x
-    , testProperty "Associativity: take a look at tests/Laws.hs" $
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
         \x -> lawAssociativity @(Over String) @Int @Int x ]
 
-overTheorems :: TestTree
+overTheorems :: Tests
 overTheorems = testGroup "Theorems"
-    [ testProperty "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
         \x -> theorem1 @(Over String) @Int @Int x
-    , testProperty "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
         \x -> theorem2 @(Over String) @Int @Int @Int x
-    , testProperty "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
         \x -> theorem3 @(Over String) @Int @Int @Int x
-    , testProperty "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
+    , expectSuccess "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
         \x -> theorem4 @(Over String) @Int @Int x
-    , testProperty "(f <*> g) == (f `apS` g)" $
+    , expectSuccess "(f <*> g) == (f `apS` g)" $
         \x -> theorem5 @(Over String) @Int @Int x
-    , testProperty "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+    , expectSuccess "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
         \x -> theorem6 @(Over String) @Int @Int x ]
 
-overProperties :: TestTree
+overProperties :: Tests
 overProperties = testGroup "Properties"
-    [ expectFail $
-      testProperty "pure-right: pure (Right x) <*? y = pure x" $
+    [ expectFailure "pure-right: pure (Right x) <*? y = pure x" $
         \x -> propertyPureRight @(Over String) @Int @Int x
-    , testProperty "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+    , expectSuccess "pure-left: pure (Left x) <*? y = ($x) <$> y" $
         \x -> propertyPureLeft @(Over String) @Int @Int x ]
 
 --------------------------------------------------------------------------------
 ------------------------ Under -------------------------------------------------
 --------------------------------------------------------------------------------
-under :: TestTree
-under = testGroup "Under" [underLaws, underTheorems, underProperties]
+under :: Tests
+under = testGroup "Under"
+    [ underLaws
+    , underTheorems
+    , underProperties ]
 
-underLaws :: TestTree
+underLaws :: Tests
 underLaws = testGroup "Laws"
-    [ testProperty "Identity: (x <*? pure id) == (either id id <$> x)" $
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
         \x -> lawIdentity @(Under String) x
-    , testProperty "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
         \x -> lawDistributivity @(Under String) @Int @Int x
-    , testProperty "Associativity: take a look at tests/Laws.hs" $
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
         \x -> lawAssociativity @(Under String) @Int @Int x ]
 
-underTheorems :: TestTree
+underTheorems :: Tests
 underTheorems = testGroup "Theorems"
-    [ testProperty "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
         \x -> theorem1 @(Under String) @Int @Int x
-    , testProperty "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
         \x -> theorem2 @(Under String) @Int @Int @Int x
-    , testProperty "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
         \x -> theorem3 @(Under String) @Int @Int @Int x
-    , testProperty "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
+    , expectSuccess "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
         \x -> theorem4 @(Under String) @Int @Int x
     -- 'Under' is a non-rigid selective functor
-    , expectFail $ testProperty "(f <*> g) == (f `apS` g)" $
+    , expectFailure "(f <*> g) == (f `apS` g)" $
         \x -> theorem5 @(Under String) @Int @Int x
-    , testProperty "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+    , expectSuccess "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
         \x -> theorem6 @(Under String) @Int @Int x ]
 
-underProperties :: TestTree
+underProperties :: Tests
 underProperties = testGroup "Properties"
-    [ testProperty "pure-right: pure (Right x) <*? y = pure x" $
+    [ expectSuccess "pure-right: pure (Right x) <*? y = pure x" $
         \x -> propertyPureRight @(Under String) @Int @Int x
-    , expectFail $
-      testProperty "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+    , expectFailure "pure-left: pure (Left x) <*? y = ($x) <$> y" $
         \x -> propertyPureLeft @(Under String) @Int @Int x ]
 
 --------------------------------------------------------------------------------
 ------------------------ Validation --------------------------------------------
 --------------------------------------------------------------------------------
 --------------------------------------------------------------------------------
-validation :: TestTree
+validation :: Tests
 validation = testGroup "Validation"
-    [validationLaws, validationTheorems, validationProperties, validationExample]
+    [ validationLaws
+    , validationTheorems
+    , validationProperties
+    , validationExample ]
 
-validationLaws :: TestTree
+validationLaws :: Tests
 validationLaws = testGroup "Laws"
-    [ testProperty "Identity: (x <*? pure id) == (either id id <$> x)" $
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
         \x -> lawIdentity @(Validation String) @Int x
-    , testProperty "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
         \x -> lawDistributivity @(Validation String) @Int @Int x
-    , testProperty "Associativity: take a look at tests/Laws.hs" $
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
         \x -> lawAssociativity @(Validation String) @Int @Int @Int x ]
 
-validationTheorems :: TestTree
+validationTheorems :: Tests
 validationTheorems = testGroup "Theorems"
-    [ testProperty "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
         \x -> theorem1 @(Validation String) @Int @Int @Int x
-    , testProperty "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
         \x -> theorem2 @(Validation String) @Int @Int @Int x
-    , testProperty "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
         \x -> theorem3 @(Validation String) @Int @Int @Int x
-    , testProperty "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
+    , expectSuccess "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
         \x -> theorem4 @(Validation String) @Int @Int x
     -- 'Validation' is a non-rigid selective functor
-    , expectFail $ testProperty "(f <*> g) == (f `apS` g)" $
+    , expectFailure "(f <*> g) == (f `apS` g)" $
         \x -> theorem5 @(Validation String) @Int @Int x
     -- 'Validation' is a non-rigid selective functor
-    , expectFail $ testProperty "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+    , expectFailure "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
         \x -> theorem6 @(Validation String) @Int @Int @Int x ]
 
-validationProperties :: TestTree
+validationProperties :: Tests
 validationProperties = testGroup "Properties"
-    [ testProperty "pure-right: pure (Right x) <*? y = pure x" $
+    [ expectSuccess "pure-right: pure (Right x) <*? y = pure x" $
         \x -> propertyPureRight @(Validation String) @Int @Int x
-    , testProperty "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+    , expectSuccess "pure-left: pure (Left x) <*? y = ($x) <$> y" $
         \x -> propertyPureLeft @(Validation String) @Int @Int x ]
 
-validationExample :: TestTree
+validationExample :: Tests
 validationExample = testGroup "validationExample"
-    [ testProperty "shape (Success True) (Success 1) (Failure [\"width?\"]) (Failure [\"height?\"])" $
+    [ expectSuccess "shape (Success True) (Success 1) (Failure [\"width?\"]) (Failure [\"height?\"])" $
         shape (Success True) (Success 1) (Failure ["width?"]) (Failure ["height?"]) == Success (Circle 1)
-    , testProperty "shape (Success False) (Failure [\"radius?\"]) (Success 2) (Success 3)" $
+    , expectSuccess "shape (Success False) (Failure [\"radius?\"]) (Success 2) (Success 3)" $
         shape (Success False) (Failure ["radius?"]) (Success 2) (Success 3) == Success (Rectangle 2 3)
-    , testProperty "shape (Success False) (Failure [\"radius?\"]) (Success 2) (Failure [\"height?\"])" $
+    , expectSuccess "shape (Success False) (Failure [\"radius?\"]) (Success 2) (Failure [\"height?\"])" $
         shape (Success False) (Failure ["radius?"]) (Success 2) (Failure ["height?"]) == Failure ["height?"]
-    , testProperty "shape (Success False) (Success 1) (Failure [\"width?\"]) (Failure [\"height?\"])" $
+    , expectSuccess "shape (Success False) (Success 1) (Failure [\"width?\"]) (Failure [\"height?\"])" $
         shape (Success False) (Success 1) (Failure ["width?"]) (Failure ["height?"]) == Failure ["width?", "height?"]
-    , testProperty "shape (Failure [\"choice?\"]) (Failure [\"radius?\"]) (Success 2) (Failure [\"height?\"])" $
+    , expectSuccess "shape (Failure [\"choice?\"]) (Failure [\"radius?\"]) (Success 2) (Failure [\"height?\"])" $
         shape (Failure ["choice?"]) (Failure ["radius?"]) (Success 2) (Failure ["height?"]) == Failure ["choice?"]
-    , testProperty "twoShapes s1 s2" $
+    , expectSuccess "twoShapes s1 s2" $
         twoShapes (shape (Failure ["choice 1?"]) (Success 1) (Failure ["width 1?"]) (Success 3)) (shape (Success False) (Success 1) (Success 2) (Failure ["height 2?"])) == Failure ["choice 1?","height 2?"] ]
 
 --------------------------------------------------------------------------------
 ------------------------ ArrowMonad --------------------------------------------
 --------------------------------------------------------------------------------
-arrowMonad :: TestTree
+arrowMonad :: Tests
 arrowMonad = testGroup "ArrowMonad (->)"
-    [arrowMonadLaws, arrowMonadTheorems, arrowMonadProperties]
+    [ arrowMonadLaws
+    , arrowMonadTheorems
+    , arrowMonadProperties ]
 
-arrowMonadLaws :: TestTree
+arrowMonadLaws :: Tests
 arrowMonadLaws = testGroup "Laws"
-    [ testProperty "Identity: (x <*? pure id) == (either id id <$> x)" $
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
         \x -> lawIdentity @(ArrowMonad (->)) @Int x
-    , testProperty "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
         \x -> lawDistributivity @(ArrowMonad (->)) @Int @Int x
-    , testProperty "Associativity: take a look at tests/Laws.hs" $
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
         \x -> lawAssociativity @(ArrowMonad (->)) @Int @Int @Int x
-    , testProperty "select == selectM" $
+    , expectSuccess "select == selectM" $
         \x -> lawMonad @(ArrowMonad (->)) @Int @Int x
-    , testProperty "select == selectA" $
+    , expectSuccess "select == selectA" $
         \x -> selectALaw @(ArrowMonad (->)) @Int @Int x ]
 
-arrowMonadTheorems :: TestTree
+arrowMonadTheorems :: Tests
 arrowMonadTheorems = testGroup "Theorems"
-    [ testProperty "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
         \x -> theorem1 @(ArrowMonad (->)) @Int @Int @Int x
-    , testProperty "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
         \x -> theorem2 @(ArrowMonad (->)) @Int @Int @Int x
-    , testProperty "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
         \x -> theorem3 @(ArrowMonad (->)) @Int @Int @Int x
-    , testProperty "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
+    , expectSuccess "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
         \x -> theorem4 @(ArrowMonad (->)) @Int @Int x
-    , testProperty "(f <*> g) == (f `apS` g)" $
+    , expectSuccess "(f <*> g) == (f `apS` g)" $
         \x -> theorem5 @(ArrowMonad (->)) @Int @Int x
-    , testProperty "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+    , expectSuccess "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
         \x -> theorem6 @(ArrowMonad (->)) @Int @Int @Int x ]
 
-arrowMonadProperties :: TestTree
+arrowMonadProperties :: Tests
 arrowMonadProperties = testGroup "Properties"
-    [ testProperty "pure-right: pure (Right x) <*? y = pure x" $
+    [ expectSuccess "pure-right: pure (Right x) <*? y = pure x" $
         \x -> propertyPureRight @(ArrowMonad (->)) @Int @Int x
-    , testProperty "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+    , expectSuccess "pure-left: pure (Left x) <*? y = ($x) <$> y" $
         \x -> propertyPureLeft @(ArrowMonad (->)) @Int @Int x ]
 
 --------------------------------------------------------------------------------
 ------------------------ Maybe -------------------------------------------------
 --------------------------------------------------------------------------------
-maybe :: TestTree
-maybe = testGroup "Maybe" [maybeLaws, maybeTheorems, maybeProperties]
+maybe :: Tests
+maybe = testGroup "Maybe"
+    [ maybeLaws
+    , maybeTheorems
+    , maybeProperties ]
 
-maybeLaws :: TestTree
+maybeLaws :: Tests
 maybeLaws = testGroup "Laws"
-    [ testProperty "Identity: (x <*? pure id) == (either id id <$> x)" $
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
         \x -> lawIdentity @Maybe @Int x
-    , testProperty "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
         \x -> lawDistributivity @Maybe @Int @Int x
-    , testProperty "Associativity: take a look at tests/Laws.hs" $
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
         \x -> lawAssociativity @Maybe @Int @Int @Int x
-    , testProperty "select == selectM" $
+    , expectSuccess "select == selectM" $
         \x -> lawMonad @Maybe @Int @Int x ]
 
-maybeTheorems :: TestTree
+maybeTheorems :: Tests
 maybeTheorems = testGroup "Theorems"
-    [ testProperty "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
         \x -> theorem1 @Maybe @Int @Int @Int x
-    , testProperty "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
         \x -> theorem2 @Maybe @Int @Int @Int x
-    , testProperty "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
         \x -> theorem3 @Maybe @Int @Int @Int x
-    , testProperty "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
+    , expectSuccess "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
         \x -> theorem4 @Maybe @Int @Int x
-    , testProperty "(f <*> g) == (f `apS` g)" $
+    , expectSuccess "(f <*> g) == (f `apS` g)" $
         \x -> theorem5 @Maybe @Int @Int x
-    , testProperty "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+    , expectSuccess "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
         \x -> theorem6 @Maybe @Int @Int @Int x ]
 
-maybeProperties :: TestTree
+maybeProperties :: Tests
 maybeProperties = testGroup "Properties"
-    [ testProperty "pure-right: pure (Right x) <*? y = pure x" $
+    [ expectSuccess "pure-right: pure (Right x) <*? y = pure x" $
         \x -> propertyPureRight @Maybe @Int @Int x
-    , testProperty "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+    , expectSuccess "pure-left: pure (Left x) <*? y = ($x) <$> y" $
         \x -> propertyPureLeft @Maybe @Int @Int x ]
 
 --------------------------------------------------------------------------------
 ------------------------ Identity ----------------------------------------------
 --------------------------------------------------------------------------------
-identity :: TestTree
+identity :: Tests
 identity = testGroup "Identity"
-    [identityLaws, identityTheorems, identityProperties]
+    [ identityLaws
+    , identityTheorems
+    , identityProperties ]
 
-identityLaws :: TestTree
+identityLaws :: Tests
 identityLaws = testGroup "Laws"
-    [ testProperty "Identity: (x <*? pure id) == (either id id <$> x)" $
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
         \x -> lawIdentity @Identity @Int x
-    , testProperty "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
         \x -> lawDistributivity @Identity @Int @Int x
-    , testProperty "Associativity: take a look at tests/Laws.hs" $
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
         \x -> lawAssociativity @Identity @Int @Int @Int x
-    , testProperty "select == selectM" $
+    , expectSuccess "select == selectM" $
         \x -> lawMonad @Identity @Int @Int x ]
 
-identityTheorems :: TestTree
+identityTheorems :: Tests
 identityTheorems = testGroup "Theorems"
-    [ testProperty "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
         \x -> theorem1 @Identity @Int @Int @Int x
-    , testProperty "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
         \x -> theorem2 @Identity @Int @Int @Int x
-    , testProperty "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
         \x -> theorem3 @Identity @Int @Int @Int x
-    , testProperty "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
+    , expectSuccess "Generalised identity: (x <*? pure y) == (either y id <$> x)" $
         \x -> theorem4 @Identity @Int @Int x
-    , testProperty "(f <*> g) == (f `apS` g)" $
+    , expectSuccess "(f <*> g) == (f `apS` g)" $
         \x -> theorem5 @Identity @Int @Int x
-    , testProperty "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+    , expectSuccess "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
         \x -> theorem6 @Identity @Int @Int @Int x ]
 
-identityProperties :: TestTree
+identityProperties :: Tests
 identityProperties = testGroup "Properties"
-    [ testProperty "pure-right: pure (Right x) <*? y = pure x" $
+    [ expectSuccess "pure-right: pure (Right x) <*? y = pure x" $
         \x -> propertyPureRight @Identity @Int @Int x
-    , testProperty "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+    , expectSuccess "pure-left: pure (Left x) <*? y = ($x) <$> y" $
         \x -> propertyPureLeft @Identity @Int @Int x ]
+
+--------------------------------------------------------------------------------
+------------------------ Writer ------------------------------------------------
+--------------------------------------------------------------------------------
+
+writer :: Tests
+writer = testGroup "Writer"
+    [ writerLaws
+    , writerTheorems
+    , writerProperties ]
+
+type MyWriter = Writer [Int]
+
+writerLaws :: Tests
+writerLaws = testGroup "Laws"
+    [ expectSuccess "Identity: (x <*? pure id) == (either id id <$> x)" $
+        \x -> lawIdentity @MyWriter @Int x
+    , expectSuccess "Distributivity: (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z))" $
+        \x -> lawDistributivity @MyWriter @Int @Int x
+    , expectSuccess "Associativity: take a look at tests/Laws.hs" $
+        \x -> lawAssociativity @MyWriter @Int @Int @Int x
+    , expectSuccess "select == selectM" $
+        \x -> lawMonad @MyWriter @Int @Int x ]
+
+writerTheorems :: Tests
+writerTheorems = testGroup "Theorems"
+    [ expectSuccess "Apply a pure function to the result: (f <$> select x y) == (select (second f <$> x) ((f .) <$> y))" $
+        \x -> theorem1 @MyWriter @Int @Int @Int x
+    , expectSuccess "Apply a pure function to the Left case of the first argument: (select (first f <$> x) y) == (select x ((. f) <$> y))" $
+        \x -> theorem2 @MyWriter @Int @Int @Int x
+    , expectSuccess "Apply a pure function to the second argument: (select x (f <$> y)) == (select (first (flip f) <$> x) ((&) <$> y))" $
+        \x -> theorem3 @MyWriter @Int @Int @Int x
+    , expectSuccess "Generalised Identity: (x <*? pure y) == (either y id <$> x)" $
+        \x -> theorem4 @MyWriter @Int @Int x
+    , expectSuccess "(f <*> g) == (f `apS` g)" $
+        \x -> theorem5 @MyWriter @Int @Int x
+    , expectSuccess "Interchange: (x *> (y <*? z)) == ((x *> y) <*? z)" $
+        \x -> theorem6 @MyWriter @Int @Int @Int x ]
+
+writerProperties :: Tests
+writerProperties = testGroup "Properties"
+    [ expectSuccess "pure-right: pure (Right x) <*? y = pure x" $
+        \x -> propertyPureRight @MyWriter @Int @Int x
+    , expectSuccess "pure-left: pure (Left x) <*? y = ($x) <$> y" $
+        \x -> propertyPureLeft @MyWriter @Int @Int x ]
diff --git a/test/Sketch.hs b/test/Sketch.hs
--- a/test/Sketch.hs
+++ b/test/Sketch.hs
@@ -565,7 +565,7 @@
 newtype Haxl a = Haxl { runHaxl :: IO (Result a) } deriving Functor
 
 instance Applicative Haxl where
-    pure = return
+    pure = Haxl . return . Done
 
     Haxl iof <*> Haxl iox = Haxl $ do
         rf <- iof
@@ -586,7 +586,7 @@
             (Blocked bx x  , Blocked bf f) -> Blocked (bx <> bf) (select x f) -- speculative
                                                                               -- execution
 instance Monad Haxl where
-    return = Haxl . return . Done
+    return = pure
 
     Haxl iox >>= f = Haxl $ do
         rx <- iox
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,44 @@
+-- A little testing framework
+module Test where
+
+import Data.List (intercalate)
+import System.Exit (exitFailure)
+import Test.QuickCheck hiding (Success, Failure, expectFailure)
+
+
+data Expect = ExpectSuccess | ExpectFailure deriving Eq
+
+data Test = Test String Expect Property
+
+data Tests = Leaf Test | Node String [Tests]
+
+testGroup :: String -> [Tests] -> Tests
+testGroup = Node
+
+expectSuccess :: Testable a => String -> a -> Tests
+expectSuccess name p = Leaf $ Test name ExpectSuccess (property p)
+
+expectFailure :: Testable a => String -> a -> Tests
+expectFailure name p = Leaf $ Test name ExpectFailure (property p)
+
+runTest :: [String] -> Test -> IO ()
+runTest labels (Test name expect property) = do
+    let label = intercalate "." (reverse (name : labels))
+    result <- quickCheckWithResult (stdArgs { chatty = False }) property
+    case (expect, isSuccess result) of
+        (ExpectSuccess, True)  -> putStrLn $ "OK: " ++ label
+        (ExpectFailure, False) -> putStrLn $ "OK (expected failure): " ++ label
+        (ExpectSuccess, False) -> do
+            putStrLn $ "\nTest failure:\n    " ++ label ++ "\n"
+            putStrLn $ output result
+            exitFailure
+        (ExpectFailure, True) -> do
+            putStrLn $ "\nUnexpected test success:\n    " ++ label ++ "\n"
+            putStrLn $ output result
+            exitFailure
+
+runTests :: Tests -> IO ()
+runTests = go []
+  where
+    go labels (Leaf test)        = runTest labels test
+    go labels (Node label tests) = mapM_ (go (label : labels)) tests