Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings

```----------------------
Metric Decrease:
   T12425
Metric Increase:
   T17516
```

----------------------

compiler/GHC/Driver/Session.hs

@@ -4082,7 +4082,9 @@ standardWarnings -- see Note [Documenting warning flags]
         Opt_WarnSimplifiableClassConstraints,
         Opt_WarnStarBinder,
         Opt_WarnInaccessibleCode,
-        Opt_WarnSpaceAfterBang
+        Opt_WarnSpaceAfterBang,
+        Opt_WarnNonCanonicalMonadInstances,
+        Opt_WarnNonCanonicalMonoidInstances
       ]
 
 -- | Things you get with -W

compiler/GHC/Rename/Module.hs

@@ -426,10 +426,12 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid })
 checkCanonicalInstances :: Name -> LHsSigType GhcRn -> LHsBinds GhcRn -> RnM ()
 checkCanonicalInstances cls poly_ty mbinds = do
     whenWOptM Opt_WarnNonCanonicalMonadInstances
-        checkCanonicalMonadInstances
+        $ checkCanonicalMonadInstances
+        "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return"
 
     whenWOptM Opt_WarnNonCanonicalMonoidInstances
-        checkCanonicalMonoidInstances
+        $ checkCanonicalMonoidInstances
+        "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid"
 
   where
     -- | Warn about unsound/non-canonical 'Applicative'/'Monad' instance
@@ -445,18 +447,18 @@ checkCanonicalInstances cls poly_ty mbinds = do
     --  * Warn if 'pure' is defined backwards (i.e. @pure = return@).
     --  * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@).
     --
-    checkCanonicalMonadInstances
+    checkCanonicalMonadInstances refURL
       | cls == applicativeClassName  = do
           forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
               case mbind of
                   FunBind { fun_id = L _ name
                           , fun_matches = mg }
                       | name == pureAName, isAliasMG mg == Just returnMName
-                      -> addWarnNonCanonicalMethod1
+                      -> addWarnNonCanonicalMethod1 refURL
                             Opt_WarnNonCanonicalMonadInstances "pure" "return"
 
                       | name == thenAName, isAliasMG mg == Just thenMName
-                      -> addWarnNonCanonicalMethod1
+                      -> addWarnNonCanonicalMethod1 refURL
                             Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)"
 
                   _ -> return ()
@@ -467,11 +469,11 @@ checkCanonicalInstances cls poly_ty mbinds = do
                   FunBind { fun_id = L _ name
                           , fun_matches = mg }
                       | name == returnMName, isAliasMG mg /= Just pureAName
-                      -> addWarnNonCanonicalMethod2
+                      -> addWarnNonCanonicalMethod2 refURL
                             Opt_WarnNonCanonicalMonadInstances "return" "pure"
 
                       | name == thenMName, isAliasMG mg /= Just thenAName
-                      -> addWarnNonCanonicalMethod2
+                      -> addWarnNonCanonicalMethod2 refURL
                             Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)"
 
                   _ -> return ()
@@ -491,14 +493,14 @@ checkCanonicalInstances cls poly_ty mbinds = do
     --
     --  * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@).
     --
-    checkCanonicalMonoidInstances
+    checkCanonicalMonoidInstances refURL
       | cls == semigroupClassName  = do
           forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
               case mbind of
                   FunBind { fun_id      = L _ name
                           , fun_matches = mg }
                       | name == sappendName, isAliasMG mg == Just mappendName
-                      -> addWarnNonCanonicalMethod1
+                      -> addWarnNonCanonicalMethod1 refURL
                             Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend"
 
                   _ -> return ()
@@ -509,8 +511,9 @@ checkCanonicalInstances cls poly_ty mbinds = do
                   FunBind { fun_id = L _ name
                           , fun_matches = mg }
                       | name == mappendName, isAliasMG mg /= Just sappendName
-                      -> addWarnNonCanonicalMethod2NoDefault
-                            Opt_WarnNonCanonicalMonoidInstances "mappend" "(<>)"
+                      -> addWarnNonCanonicalMethod2 refURL
+                            Opt_WarnNonCanonicalMonoidInstances
+                            "mappend" "(<>)"
 
                   _ -> return ()
 
@@ -527,7 +530,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
     isAliasMG _ = Nothing
 
     -- got "lhs = rhs" but expected something different
-    addWarnNonCanonicalMethod1 flag lhs rhs = do
+    addWarnNonCanonicalMethod1 refURL flag lhs rhs = do
         addWarn (Reason flag) $ vcat
                        [ text "Noncanonical" <+>
                          quotes (text (lhs ++ " = " ++ rhs)) <+>
@@ -536,29 +539,26 @@ checkCanonicalInstances cls poly_ty mbinds = do
                        , text "Move definition from" <+>
                          quotes (text rhs) <+>
                          text "to" <+> quotes (text lhs)
+                       , text "See also:" <+>
+                         text refURL
                        ]
 
     -- expected "lhs = rhs" but got something else
-    addWarnNonCanonicalMethod2 flag lhs rhs = do
+    addWarnNonCanonicalMethod2 refURL flag lhs rhs = do
         addWarn (Reason flag) $ vcat
                        [ text "Noncanonical" <+>
                          quotes (text lhs) <+>
                          text "definition detected"
                        , instDeclCtxt1 poly_ty
+                       , quotes (text lhs) <+>
+                         text "will eventually be removed in favour of" <+>
+                         quotes (text rhs)
                        , text "Either remove definition for" <+>
-                         quotes (text lhs) <+> text "or define as" <+>
-                         quotes (text (lhs ++ " = " ++ rhs))
-                       ]
-
-    -- like above, but method has no default impl
-    addWarnNonCanonicalMethod2NoDefault flag lhs rhs = do
-        addWarn (Reason flag) $ vcat
-                       [ text "Noncanonical" <+>
-                         quotes (text lhs) <+>
-                         text "definition detected"
-                       , instDeclCtxt1 poly_ty
-                       , text "Define as" <+>
+                         quotes (text lhs) <+> text "(recommended)" <+>
+                         text "or define as" <+>
                          quotes (text (lhs ++ " = " ++ rhs))
+                       , text "See also:" <+>
+                         text refURL
                        ]
 
     -- stolen from GHC.Tc.TyCl.Instance

docs/users_guide/9.0.1-notes.rst

@@ -243,6 +243,10 @@ Compiler
 - A new flag :ghc-flag:`-flink-rts` to enable linking the RTS when linking
   shared libraries.
 
+- The :ghc-flag:`-Wnoncanonical-monad-instances` and
+  :ghc-flag:`-Wnoncanonical-monoid-instances` warnings are now enabled by
+  default, as proposed in `GHC proposal #314
+  <https://github.com/ghc-proposals/ghc-proposals/pull/314>`_
 
 GHCi
 ~~~~

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'
 

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

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'

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

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
- 
-  
+
+
 

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)
 

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

testsuite/tests/ghci/scripts/T4127.script

 :set -XTemplateHaskell
-Language.Haskell.TH.runQ [d| instance Monad ((,) a) where { return  = undefined; (>>=) = undefined } |]
+Language.Haskell.TH.runQ [d| instance Monad ((,) a) where { (>>=) = undefined } |]
 

testsuite/tests/ghci/scripts/T4127.stdout

-[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

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

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

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

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]

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
 
 

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

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

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

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))
 

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

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)

testsuite/tests/simplCore/should_compile/T3831.hs

 {-# 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

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

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

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)
 

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)
 

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) )

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)
 

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

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 ‘(<>)’