[commit: ghc] wip/final-mfp: testsuite: Remove Monad(fail) references (102c24d)

git at git.haskell.org git at git.haskell.org
Sun Mar 3 19:56:04 UTC 2019


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/final-mfp
Link       : http://ghc.haskell.org/trac/ghc/changeset/102c24d5d4423a3538f122f1b16999a07c70e309/ghc

>---------------------------------------------------------------

commit 102c24d5d4423a3538f122f1b16999a07c70e309
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Feb 27 21:45:29 2019 -0500

    testsuite: Remove Monad(fail) references


>---------------------------------------------------------------

102c24d5d4423a3538f122f1b16999a07c70e309
 testsuite/tests/rebindable/DoRestrictedM.hs | 1 -
 testsuite/tests/rebindable/T5908.hs         | 5 -----
 2 files changed, 6 deletions(-)

diff --git a/testsuite/tests/rebindable/DoRestrictedM.hs b/testsuite/tests/rebindable/DoRestrictedM.hs
index 2e982c1..4f78857 100644
--- a/testsuite/tests/rebindable/DoRestrictedM.hs
+++ b/testsuite/tests/rebindable/DoRestrictedM.hs
@@ -32,7 +32,6 @@ newtype RegularM m a = RegularM{unRM :: m a}
 
 instance Prelude.Monad m => MN2 (RegularM m) a where
     return = RegularM . Prelude.return
-    fail   = RegularM . Prelude.fail
 
 instance Prelude.Monad m => MN3 (RegularM m) a b where
     m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f))
diff --git a/testsuite/tests/rebindable/T5908.hs b/testsuite/tests/rebindable/T5908.hs
index 2666c33..ff5da89 100644
--- a/testsuite/tests/rebindable/T5908.hs
+++ b/testsuite/tests/rebindable/T5908.hs
@@ -25,11 +25,9 @@ class Monad m where
   (>>=) :: forall e ex x a b . m e ex a -> (a -> m ex x b) -> m e x b
   (>>) :: forall e ex x a b . m e ex a -> m ex x b -> m e x b
   return :: a -> m ex ex a
-  fail :: String -> m e x a
 
   {-# INLINE (>>) #-}
   m >> k = m >>= \ _ -> k
-  fail = error
 
 type Writer w = WriterT w Identity
 
@@ -60,9 +58,6 @@ instance (Category w, Prelude.Monad m) => Monad (WriterT w m) where
     where
       (>>=) = (Prelude.>>=)
       return = Prelude.return
-  fail msg = WriterT $ fail msg
-    where
-      fail = Prelude.fail
 
 tell :: (Category w, Prelude.Monad m) => w e x -> WriterT w m e x ()
 tell w = WriterT $ return ((), w)



More information about the ghc-commits mailing list