diff options
author | Fumiaki Kinoshita <fumiexcel@gmail.com> | 2020-07-15 21:12:07 +0900 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-10-14 18:06:12 -0400 |
commit | e60ae8a38394370fd8818ad004a101466fc7d2dc (patch) | |
tree | 6eff280150db65ae373aba5d50f550180b99983b /testsuite/tests | |
parent | bf2411a3c198cb2df93a9e0aa0c3b8297f47058d (diff) | |
download | haskell-e60ae8a38394370fd8818ad004a101466fc7d2dc.tar.gz |
Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings
-------------------------
Metric Decrease:
T12425
Metric Increase:
T17516
-------------------------
Diffstat (limited to 'testsuite/tests')
29 files changed, 45 insertions, 74 deletions
diff --git a/testsuite/tests/codeGen/should_compile/jmp_tbl.hs b/testsuite/tests/codeGen/should_compile/jmp_tbl.hs index c7211b0ebd..4b4c866992 100644 --- a/testsuite/tests/codeGen/should_compile/jmp_tbl.hs +++ b/testsuite/tests/codeGen/should_compile/jmp_tbl.hs @@ -82,11 +82,10 @@ instance Functor CompPipeline where fmap = liftM instance Applicative CompPipeline where - pure = return + pure a = P $ \state -> return (state, a) (<*>) = ap instance Monad CompPipeline where - return a = P $ \state -> return (state, a) P m >>= k = P $ \state -> do (state',a) <- m state unP (k a) state' diff --git a/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs b/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs index e5175b658d..a151a2a909 100644 --- a/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs +++ b/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs @@ -25,7 +25,7 @@ instance Functor (StateTrans s) where fmap = liftM instance Applicative (StateTrans s) where - pure = return + pure v= ST (\s -> (s, Just v)) (<*>) = ap instance Monad (StateTrans s) where @@ -40,8 +40,6 @@ instance Monad (StateTrans s) where q s1 Nothing -> (s1, Nothing) ) - return v - = ST (\s -> (s, Just v)) -- machine state transitions diff --git a/testsuite/tests/deriving/should_compile/drv020.hs b/testsuite/tests/deriving/should_compile/drv020.hs index bd5c8f4235..fc1f953715 100644 --- a/testsuite/tests/deriving/should_compile/drv020.hs +++ b/testsuite/tests/deriving/should_compile/drv020.hs @@ -22,11 +22,10 @@ instance Functor (State s) where fmap = liftM instance Applicative (State s) where - pure = return + pure a = State $ \s -> (a, s) (<*>) = ap instance Monad (State s) where - return a = State $ \s -> (a, s) m >>= k = State $ \s -> let (a, s') = runState m s in runState (k a) s' diff --git a/testsuite/tests/determinism/determ019/A.hs b/testsuite/tests/determinism/determ019/A.hs index 9984780204..3b69438fd7 100644 --- a/testsuite/tests/determinism/determ019/A.hs +++ b/testsuite/tests/determinism/determ019/A.hs @@ -40,7 +40,6 @@ newtype StateT s m a = StateT { runStateT :: s -> m (a, s) } instance MonadFix m => Monad (StateT s m) where - return x = StateT $ \s -> pure (x, s) m >>= f = StateT $ \s -> do rec (x, s'') <- runStateT m s' @@ -49,7 +48,7 @@ instance MonadFix m => Monad (StateT s m) where instance MonadFix m => Applicative (StateT s m) where (<*>) = ap - pure = return + pure x = StateT $ \s -> pure (x, s) instance Functor m => Functor (StateT s m) where -- this instance is hand-written diff --git a/testsuite/tests/gadt/gadt16.hs b/testsuite/tests/gadt/gadt16.hs index 194ed5d6ea..8398910812 100644 --- a/testsuite/tests/gadt/gadt16.hs +++ b/testsuite/tests/gadt/gadt16.hs @@ -30,28 +30,26 @@ instance Functor (M s) where fmap = liftM instance Applicative (M s) where - pure = return + pure x = M (return (Ok x)) (<*>) = ap -instance Monad (M s) where +instance Monad (M s) where - return x = M (return (Ok x)) - {- this one gives a type error in 6.4.1 -} M m >>= k = M (do res <- m - case res of + case res of Ok x -> unM (k x) Fail -> return Fail - ) + ) - {- while this one works -} + {- while this one works -} -- M m >>= k = M (f m (unM . k)) - -- where + -- where -- f :: IO (Result s a) -> (a -> IO (Result s b)) -> IO (Result s b) -- f m k = do res <- m -- case res of -- Ok x -> k x -- Fail -> return Fail - - + + diff --git a/testsuite/tests/gadt/nbe.hs b/testsuite/tests/gadt/nbe.hs index 103319ad1d..e92763d3b3 100644 --- a/testsuite/tests/gadt/nbe.hs +++ b/testsuite/tests/gadt/nbe.hs @@ -94,11 +94,10 @@ instance Functor Tree where fmap = liftM instance Applicative Tree where - pure = return + pure = Val (<*>) = ap instance Monad Tree where - return x = Val x (Val a) >>= f = f a (Choice l r) >>= f = Choice (l >>= f) (r >>= f) diff --git a/testsuite/tests/ghci.debugger/HappyTest.hs b/testsuite/tests/ghci.debugger/HappyTest.hs index 8eac4e714f..ec00fb4c52 100644 --- a/testsuite/tests/ghci.debugger/HappyTest.hs +++ b/testsuite/tests/ghci.debugger/HappyTest.hs @@ -173,13 +173,13 @@ instance Functor HappyIdentity where fmap = liftM instance Applicative HappyIdentity where - pure = return + pure = HappyIdentity (<*>) = ap instance Monad HappyIdentity where - return = HappyIdentity (HappyIdentity p) >>= q = q p + happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b happyThen = (>>=) happyReturn :: () => a -> HappyIdentity a diff --git a/testsuite/tests/ghci/scripts/T4127.script b/testsuite/tests/ghci/scripts/T4127.script index 6c89f5b533..804f28c982 100644 --- a/testsuite/tests/ghci/scripts/T4127.script +++ b/testsuite/tests/ghci/scripts/T4127.script @@ -1,3 +1,3 @@ :set -XTemplateHaskell -Language.Haskell.TH.runQ [d| instance Monad ((,) a) where { return = undefined; (>>=) = undefined } |] +Language.Haskell.TH.runQ [d| instance Monad ((,) a) where { (>>=) = undefined } |] diff --git a/testsuite/tests/ghci/scripts/T4127.stdout b/testsuite/tests/ghci/scripts/T4127.stdout index abb0373bf1..509bb88835 100644 --- a/testsuite/tests/ghci/scripts/T4127.stdout +++ b/testsuite/tests/ghci/scripts/T4127.stdout @@ -1 +1 @@ -[InstanceD Nothing [] (AppT (ConT GHC.Base.Monad) (AppT (ConT GHC.Tuple.(,)) (VarT a_0))) [ValD (VarP GHC.Base.return) (NormalB (VarE GHC.Err.undefined)) [],ValD (VarP GHC.Base.>>=) (NormalB (VarE GHC.Err.undefined)) []]] +[InstanceD Nothing [] (AppT (ConT GHC.Base.Monad) (AppT (ConT GHC.Tuple.(,)) (VarT a_0))) [ValD (VarP GHC.Base.>>=) (NormalB (VarE GHC.Err.undefined)) []]]
\ No newline at end of file diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout index 12f5958925..78c1ec819d 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout +++ b/testsuite/tests/ghci/scripts/T9293.stdout @@ -14,7 +14,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should fail, GADTs is not enabled @@ -37,7 +36,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should work, GADTs is in force from :set @@ -59,7 +57,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should fail, GADTs is now disabled @@ -83,7 +80,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should fail, GADTs is only enabled at the prompt diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout index c2efd4e68f..bd8ee9361e 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout +++ b/testsuite/tests/ghci/scripts/ghci024.stdout @@ -15,7 +15,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports ~~~~~~~~~~ Testing :set -a diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout index 12f5958925..78c1ec819d 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout +++ b/testsuite/tests/ghci/scripts/ghci057.stdout @@ -14,7 +14,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should fail, GADTs is not enabled @@ -37,7 +36,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should work, GADTs is in force from :set @@ -59,7 +57,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should fail, GADTs is now disabled @@ -83,7 +80,6 @@ other dynamic, non-language, flag settings: -fshow-warning-groups warning settings: -Wsemigroup - -Wnoncanonical-monoid-instances -Wstar-is-type -Wcompat-unqualified-imports Should fail, GADTs is only enabled at the prompt diff --git a/testsuite/tests/mdo/should_fail/mdofail004.hs b/testsuite/tests/mdo/should_fail/mdofail004.hs index 929785423c..a313747e8a 100644 --- a/testsuite/tests/mdo/should_fail/mdofail004.hs +++ b/testsuite/tests/mdo/should_fail/mdofail004.hs @@ -19,11 +19,10 @@ instance Functor X where fmap = liftM instance Applicative X where - pure = return + pure = X (<*>) = ap instance Monad X where - return = X (X a) >>= f = f a z :: X [Int] diff --git a/testsuite/tests/partial-sigs/should_compile/Meltdown.hs b/testsuite/tests/partial-sigs/should_compile/Meltdown.hs index 963af55a25..318dc2488d 100644 --- a/testsuite/tests/partial-sigs/should_compile/Meltdown.hs +++ b/testsuite/tests/partial-sigs/should_compile/Meltdown.hs @@ -13,7 +13,6 @@ instance Applicative (NukeMonad a b) where (<*>) = undefined instance Monad (NukeMonad a b) where - return = undefined (>>=) = undefined diff --git a/testsuite/tests/perf/compiler/T12425.hs b/testsuite/tests/perf/compiler/T12425.hs index 6f23440fda..8ce441974e 100644 --- a/testsuite/tests/perf/compiler/T12425.hs +++ b/testsuite/tests/perf/compiler/T12425.hs @@ -25,7 +25,6 @@ instance Monad m => Applicative (CondT a m) where (<*>) = undefined instance Monad m => Monad (CondT a m) where - return = undefined (>>=) = undefined -- liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r diff --git a/testsuite/tests/perf/compiler/T3064.hs b/testsuite/tests/perf/compiler/T3064.hs index e29dd95564..298a09cecf 100644 --- a/testsuite/tests/perf/compiler/T3064.hs +++ b/testsuite/tests/perf/compiler/T3064.hs @@ -15,7 +15,6 @@ instance Applicative f => Applicative (ReaderT r f) where f <*> v = ReaderT $ \r -> runReaderT f r <*> runReaderT v r instance (Monad m) => Monad (ReaderT r m) where - return a = ReaderT $ \_ -> return a m >>= k = ReaderT $ \r -> do a <- runReaderT m r runReaderT (k a) r diff --git a/testsuite/tests/rebindable/rebindable9.hs b/testsuite/tests/rebindable/rebindable9.hs index 53f408223f..0776e1da56 100644 --- a/testsuite/tests/rebindable/rebindable9.hs +++ b/testsuite/tests/rebindable/rebindable9.hs @@ -16,19 +16,18 @@ instance Prelude.Functor Identity where fmap = liftM instance Applicative Identity where - pure = Prelude.return + pure = Identity (<*>) = ap instance Prelude.Monad Identity where - return a = Identity a m >>= k = k (runIdentity m) -class Bind m1 m2 m3 | m1 m2 -> m3 where +class Bind m1 m2 m3 | m1 m2 -> m3 where (>>=) :: m1 a -> (a -> m2 b) -> m3 b class Return m where returnM :: a -> m a - fail :: String -> m a + fail :: String -> m a instance Bind Maybe [] [] where Just x >>= f = f x @@ -39,15 +38,15 @@ instance Functor a => Bind a Identity a where m >>= f = fmap (runIdentity . f) instance Prelude.Monad m => Bind m m m where (>>=) = (Prelude.>>=) -instance Return [] where +instance Return [] where returnM x = [x] - fail _ = [] + fail _ = [] return :: a -> Identity a return = Prelude.return should_compile :: [Int] -should_compile = do +should_compile = do a <- Just 1 b <- [a*1,a*2] return (b+1)
\ No newline at end of file diff --git a/testsuite/tests/simplCore/prog002/Simpl009Help.hs b/testsuite/tests/simplCore/prog002/Simpl009Help.hs index b64639ec8a..b1e2a080e2 100644 --- a/testsuite/tests/simplCore/prog002/Simpl009Help.hs +++ b/testsuite/tests/simplCore/prog002/Simpl009Help.hs @@ -3,7 +3,7 @@ -- Helper for simpl009.hs (see comments there) module Simpl009Help where - + import Control.Applicative (Applicative(..), Alternative(empty, (<|>))) import Control.Monad @@ -19,12 +19,12 @@ instance Functor (Parser s) where fmap = liftM instance Applicative (Parser s) where - pure = return + pure a = Parser (\fut -> fut a) (<*>) = ap instance Monad (Parser s) where - return a = Parser (\fut -> fut a) - + + Parser f >>= k = Parser (\fut -> f (\a -> let Parser g = k a in g fut)) diff --git a/testsuite/tests/simplCore/should_compile/EvalTest.hs b/testsuite/tests/simplCore/should_compile/EvalTest.hs index dbaba0515d..2795c0421e 100644 --- a/testsuite/tests/simplCore/should_compile/EvalTest.hs +++ b/testsuite/tests/simplCore/should_compile/EvalTest.hs @@ -20,11 +20,10 @@ instance Functor Eval where fmap = liftM instance Applicative Eval where - pure = return + pure = Done (<*>) = ap instance Monad Eval where - return x = Done x Done x >>= k = k x -- Note: pattern 'Done x' makes '>>=' strict rpar :: a -> Eval a diff --git a/testsuite/tests/simplCore/should_compile/T10176.hs b/testsuite/tests/simplCore/should_compile/T10176.hs index e91ccda4e9..c4d738db09 100644 --- a/testsuite/tests/simplCore/should_compile/T10176.hs +++ b/testsuite/tests/simplCore/should_compile/T10176.hs @@ -13,11 +13,10 @@ instance Functor (ReaderT r) where instance Applicative (ReaderT r) where pure = liftReaderT . pure f <*> v = undefined + m *> k = ReaderT $ \r -> do runReaderT m r; runReaderT k r instance Monad (ReaderT r) where - return = liftReaderT . return m >>= k = undefined - m >> k = ReaderT $ \r -> do runReaderT m r; runReaderT k r liftReaderT :: IO a -> ReaderT r a liftReaderT m = ReaderT (const m) diff --git a/testsuite/tests/simplCore/should_compile/T3831.hs b/testsuite/tests/simplCore/should_compile/T3831.hs index 554e786cf2..22689002e5 100644 --- a/testsuite/tests/simplCore/should_compile/T3831.hs +++ b/testsuite/tests/simplCore/should_compile/T3831.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-} --- This test has a deep nest of join points, which led to +-- This test has a deep nest of join points, which led to -- an exponential blow-up in GHC.Core.Opt.SpecConstr module T3831(setAttributes) where @@ -24,11 +24,10 @@ instance Functor Capability where fmap = liftM instance Applicative Capability where - pure = return + pure = Capability . const . return . Just (<*>) = ap instance Monad Capability where - return = Capability . const . return . Just Capability f >>= g = Capability $ \t -> do mx <- f t case mx of diff --git a/testsuite/tests/simplCore/should_compile/T4203.hs b/testsuite/tests/simplCore/should_compile/T4203.hs index 3bf9259544..62e1957529 100644 --- a/testsuite/tests/simplCore/should_compile/T4203.hs +++ b/testsuite/tests/simplCore/should_compile/T4203.hs @@ -32,11 +32,10 @@ instance Functor Gen where fmap = liftM instance Applicative Gen where - pure = return + pure = Gen (<*>) = ap instance Monad Gen where - return a = Gen a Gen m >>= k = Gen (let Gen m' = k m in m') class Arbitrary a where diff --git a/testsuite/tests/simplCore/should_compile/T8331.hs b/testsuite/tests/simplCore/should_compile/T8331.hs index a7dc318826..3ad183e293 100644 --- a/testsuite/tests/simplCore/should_compile/T8331.hs +++ b/testsuite/tests/simplCore/should_compile/T8331.hs @@ -19,7 +19,6 @@ instance (Functor m) => Functor (ReaderT r m) where fmap f = mapReaderT (fmap f) instance (Monad m) => Monad (ReaderT r m) where - return x = ReaderT (\_ -> return x) m >>= k = ReaderT $ \ r -> do a <- runReaderT m r runReaderT (k a) r diff --git a/testsuite/tests/typecheck/should_compile/T3955.hs b/testsuite/tests/typecheck/should_compile/T3955.hs index dc594c1b7b..3f37fb6e1a 100644 --- a/testsuite/tests/typecheck/should_compile/T3955.hs +++ b/testsuite/tests/typecheck/should_compile/T3955.hs @@ -8,19 +8,18 @@ module T3955 where import Control.Applicative (Applicative(..)) import Control.Monad (liftM, ap) -class (Monad m) => MonadReader r m +class (Monad m) => MonadReader r m newtype Reader r a = Reader { runReader :: r -> a } instance Functor (Reader r) where fmap = liftM instance Applicative (Reader r) where - pure = return + pure = error "urk" (<*>) = ap instance Monad (Reader r) where (>>=) = error "urk" - return = error "urk" instance MonadReader r (Reader r) diff --git a/testsuite/tests/typecheck/should_compile/T4952.hs b/testsuite/tests/typecheck/should_compile/T4952.hs index 3ec255c5a4..2673ffce93 100644 --- a/testsuite/tests/typecheck/should_compile/T4952.hs +++ b/testsuite/tests/typecheck/should_compile/T4952.hs @@ -31,7 +31,6 @@ instance Applicative (M m) where instance Monad m => Monad (M m) where (>>=) = undefined - return = undefined instance MonadError e m => MonadError e (M m) diff --git a/testsuite/tests/typecheck/should_compile/Tc239_Help.hs b/testsuite/tests/typecheck/should_compile/Tc239_Help.hs index 1718c99088..0c861742f4 100644 --- a/testsuite/tests/typecheck/should_compile/Tc239_Help.hs +++ b/testsuite/tests/typecheck/should_compile/Tc239_Help.hs @@ -11,11 +11,10 @@ instance Functor (WrapIO e) where fmap = liftM instance Applicative (WrapIO e) where - pure = return + pure x = MkWrapIO (return x) (<*>) = ap instance Monad (WrapIO e) where - return x = MkWrapIO (return x) m >>= f = MkWrapIO (do x <- unwrap m unwrap (f x) ) diff --git a/testsuite/tests/typecheck/should_compile/tc093.hs b/testsuite/tests/typecheck/should_compile/tc093.hs index c0ae576e95..fda7d9d5ce 100644 --- a/testsuite/tests/typecheck/should_compile/tc093.hs +++ b/testsuite/tests/typecheck/should_compile/tc093.hs @@ -13,19 +13,18 @@ unitState a = State (\s0 -> (a,s0)) bindState :: State c a -> (a -> State c b) -> State c b bindState m k = State (\s0 -> let (a,s1) = (unState m) s0 - (b,s2) = (unState (k a)) s1 + (b,s2) = (unState (k a)) s1 in (b,s2)) instance Eq c => Functor (State c) where fmap = liftM instance Eq c => Applicative (State c) where - pure = return + pure = unitState (<*>) = ap instance Eq c => Monad (State c) where - return = unitState - (>>=) = bindState + (>>=) = bindState data TS = TS { vs::Int } deriving (Show,Eq) diff --git a/testsuite/tests/typecheck/should_compile/tc232.hs b/testsuite/tests/typecheck/should_compile/tc232.hs index 0f3294cac7..ae09727d21 100644 --- a/testsuite/tests/typecheck/should_compile/tc232.hs +++ b/testsuite/tests/typecheck/should_compile/tc232.hs @@ -19,7 +19,6 @@ instance Applicative (L m) where instance Monad m => Monad (L m) where (>>=) = undefined - return = undefined zork :: (Monad m) => a -> L m () zork = undefined diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index 7d3c2a6982..6c3555797d 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -3,15 +3,18 @@ Template.hs:7:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -Template.hs:13:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:13:3: warning: [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semigroup S’. Move definition from ‘mappend’ to ‘(<>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid -Template.hs:16:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:16:3: warning: [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. - Define as ‘mappend = (<>)’ + ‘mappend’ will eventually be removed in favour of ‘(<>)’ + Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid Template.hs:20:15: warning: [-Wstar-is-type (in -Wall, -Wcompat)] Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ |