diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index a819caf7a0d3996a613e5ad574db3dff15ccf34a..860e26d0c171b1bfad841c30b6d9b7353f51db94 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -953,7 +953,8 @@ standardWarnings -- see Note [Documenting warning flags]
         Opt_WarnBadlyStagedTypes,
         Opt_WarnTypeEqualityRequiresOperators,
         Opt_WarnInconsistentFlags,
-        Opt_WarnDataKindsTC
+        Opt_WarnDataKindsTC,
+        Opt_WarnTypeEqualityOutOfScope
       ]
 
 -- | Things you get with -W
@@ -1002,10 +1003,7 @@ minusWeverythingOpts = [ toEnum 0 .. ]
 -- code future compatible to fix issues before they even generate warnings.
 minusWcompatOpts :: [WarningFlag]
 minusWcompatOpts
-    = [ Opt_WarnNonCanonicalMonoidInstances
-      , Opt_WarnNonCanonicalMonadInstances
-      , Opt_WarnCompatUnqualifiedImports
-      , Opt_WarnTypeEqualityOutOfScope
+    = [ Opt_WarnCompatUnqualifiedImports
       , Opt_WarnImplicitRhsQuantification
       , Opt_WarnDeprecatedTypeAbstractions
       ]
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index c759bed50fea59b39b3c3df0cc616143e6697fb2..6713c8f7b971dd03eb4e8256386c1593e946c9fe 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -78,8 +78,12 @@ as ``-Wno-...`` for every individual warning in the group.
         * :ghc-flag:`-Wforall-identifier`
         * :ghc-flag:`-Wgadt-mono-local-binds`
         * :ghc-flag:`-Wtype-equality-requires-operators`
+        * :ghc-flag:`-Wtype-equality-out-of-scope`
         * :ghc-flag:`-Wbadly-staged-types`
         * :ghc-flag:`-Winconsistent-flags`
+        * :ghc-flag:`-Wnoncanonical-monoid-instances`
+        * :ghc-flag:`-Wnoncanonical-monad-instances`
+        * :ghc-flag:`-Wdata-kinds-tc`
 
 .. ghc-flag:: -W
     :shortdesc: enable normal warnings
@@ -165,10 +169,7 @@ as ``-Wno-...`` for every individual warning in the group.
     .. hlist::
         :columns: 3
 
-        * :ghc-flag:`-Wnoncanonical-monoid-instances`
-        * :ghc-flag:`-Wnoncanonical-monad-instances`
         * :ghc-flag:`-Wcompat-unqualified-imports`
-        * :ghc-flag:`-Wtype-equality-out-of-scope`
         * :ghc-flag:`-Wimplicit-rhs-quantification`
         * :ghc-flag:`-Wdeprecated-type-abstractions`
 
@@ -590,8 +591,6 @@ of ``-W(no-)*``.
      * Warn if ``pure`` is defined backwards (i.e. ``pure = return``).
      * Warn if ``(*>)`` is defined backwards (i.e. ``(*>) = (>>)``).
 
-    This warning is  part of the :ghc-flag:`-Wcompat` option group.
-
 .. ghc-flag:: -Wnoncanonical-monadfail-instances
     :shortdesc: *(deprecated)*
         warn when ``Monad`` or ``MonadFail`` instances have
@@ -635,8 +634,6 @@ of ``-W(no-)*``.
 
      * Warn if ``(<>)`` is defined backwards (i.e. ``(<>) = mappend``).
 
-    This warning is  part of the :ghc-flag:`-Wcompat` option group.
-
 .. ghc-flag:: -Wmissing-monadfail-instances
     :shortdesc: *(deprecated)*
         Warn when a failable pattern is used in a do-block that does
@@ -2375,6 +2372,7 @@ of ``-W(no-)*``.
     :reverse: -Wno-type-equality-out-of-scope
 
     :since: 9.4.1
+    :default: on
 
     In accordance with `GHC Proposal #371
     <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0371-non-magical-eq.md>`__,
@@ -2391,9 +2389,6 @@ of ``-W(no-)*``.
     custom Prelude. In this case, consider updating your custom Prelude to
     re-export ``~`` from ``Data.Type.Equality``.
 
-    Being part of the :ghc-flag:`-Wcompat` option group, this warning is off by
-    default, but will be switched on in a future GHC release.
-
 .. ghc-flag:: -Wtype-equality-requires-operators
     :shortdesc: warn when type equality ``a ~ b`` is used despite being out of scope
     :type: dynamic
diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout
index 8af7066534f9c91b4ba58ae1cb130efe7ae926b1..2ffd2f63c51db86968b86b8e6e288a11c92c63d9 100644
--- a/testsuite/tests/ghci/scripts/ghci024.stdout
+++ b/testsuite/tests/ghci/scripts/ghci024.stdout
@@ -17,7 +17,6 @@ other dynamic, non-language, flag settings:
   -fbreak-points
 warning settings:
   -Wcompat-unqualified-imports
-  -Wtype-equality-out-of-scope
   -Wimplicit-rhs-quantification
   -Wdeprecated-type-abstractions
 ~~~~~~~~~~ Testing :set -a
diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
index 8914a08aeefca96f6b4ae64b50549e8829f027a3..0af942df938decdd8f2a2c3820ddc16d88cb3e7d 100644
--- a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
+++ b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32
@@ -16,7 +16,6 @@ other dynamic, non-language, flag settings:
   -fbreak-points
 warning settings:
   -Wcompat-unqualified-imports
-  -Wtype-equality-out-of-scope
   -Wimplicit-rhs-quantification
   -Wdeprecated-type-abstractions
 ~~~~~~~~~~ Testing :set -a
diff --git a/testsuite/tests/warnings/should_compile/T18862b.hs b/testsuite/tests/warnings/should_compile/T18862b.hs
index 7259547b7cfd888b9249601dc9928cbe0e4c3332..d6c50aa41d11b382d89e625499e6dedeb9e427b6 100644
--- a/testsuite/tests/warnings/should_compile/T18862b.hs
+++ b/testsuite/tests/warnings/should_compile/T18862b.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -Wcompat -Wno-error=type-equality-out-of-scope #-}
+{-# OPTIONS -Wno-error=type-equality-out-of-scope #-}
 
 module T18862b where
 
diff --git a/testsuite/tests/warnings/should_compile/T18862b.stderr b/testsuite/tests/warnings/should_compile/T18862b.stderr
index 8f0514131bc7fef1f032bce1a6dc427b7225d127..9ef46e6edc978864f90db77cae8a2e973803e8d5 100644
--- a/testsuite/tests/warnings/should_compile/T18862b.stderr
+++ b/testsuite/tests/warnings/should_compile/T18862b.stderr
@@ -1,5 +1,5 @@
 
-T18862b.hs:7:9: warning: [GHC-12003] [-Wtype-equality-out-of-scope (in -Wcompat)]
+T18862b.hs:7:9: warning: [GHC-12003] [-Wtype-equality-out-of-scope (in -Wdefault)]
     • The ‘~’ operator is out of scope.
       Assuming it to stand for an equality constraint.
     • NB: ‘~’ used to be built-in syntax but now is a regular type operator
diff --git a/testsuite/tests/warnings/should_compile/WarnNoncanonical.hs b/testsuite/tests/warnings/should_compile/WarnNoncanonical.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7a49d105340cd722a9e38b785bd0280ed1c7d16f
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/WarnNoncanonical.hs
@@ -0,0 +1,28 @@
+module WarnNoncanonical where
+
+import qualified Data.Semigroup as Semi
+
+-- -fwarn-noncanonical-monoid-instances
+newtype S = S Int
+
+instance Semi.Semigroup S where
+  (<>) = mappend
+
+instance Monoid S where
+  S a `mappend` S b = S (a+b)
+  mempty = S 0
+
+newtype M a = M a
+
+instance Functor M where
+  fmap = undefined
+
+instance Applicative M where
+  liftA2 = undefined
+  pure = return
+  (*>) = (>>)
+
+instance Monad M where
+  return = undefined
+  (>>=) = undefined
+  (>>) = undefined
diff --git a/testsuite/tests/warnings/should_compile/WarnNoncanonical.stderr b/testsuite/tests/warnings/should_compile/WarnNoncanonical.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..c9eafae4161dec563bfd5f5b3950c821cd698a9b
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/WarnNoncanonical.stderr
@@ -0,0 +1,45 @@
+
+WarnNoncanonical.hs:9:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault)]
+    Noncanonical ‘(<>) = mappend’ definition detected
+    in the instance declaration for ‘Semigroup S’.
+    Suggested fix:
+      Move definition from ‘mappend’ to ‘(<>)’
+      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid
+
+WarnNoncanonical.hs:12:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault)]
+    Noncanonical ‘mappend’ definition detected
+    in the instance declaration for ‘Monoid S’.
+    ‘mappend’ will eventually be removed in favour of ‘(<>)’
+    Suggested fix:
+      Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’
+      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid
+
+WarnNoncanonical.hs:22:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault)]
+    Noncanonical ‘pure = return’ definition detected
+    in the instance declaration for ‘Applicative M’.
+    Suggested fix:
+      Move definition from ‘return’ to ‘pure’
+      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
+
+WarnNoncanonical.hs:23:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault)]
+    Noncanonical ‘(*>) = (>>)’ definition detected
+    in the instance declaration for ‘Applicative M’.
+    Suggested fix:
+      Move definition from ‘(>>)’ to ‘(*>)’
+      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
+
+WarnNoncanonical.hs:26:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault)]
+    Noncanonical ‘return’ definition detected
+    in the instance declaration for ‘Monad M’.
+    ‘return’ will eventually be removed in favour of ‘pure’
+    Suggested fix:
+      Either remove definition for ‘return’ (recommended) or define as ‘return = pure’
+      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
+
+WarnNoncanonical.hs:28:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault)]
+    Noncanonical ‘(>>)’ definition detected
+    in the instance declaration for ‘Monad M’.
+    ‘(>>)’ will eventually be removed in favour of ‘(*>)’
+    Suggested fix:
+      Either remove definition for ‘(>>)’ (recommended) or define as ‘(>>) = (*>)’
+      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index a59dcd1c50e2c661e99df453f72d65bafda0883e..468675d29e2c5daf586d5050dfe2798ffcbb543d 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -68,3 +68,4 @@ test('T22702b', normal, compile, [''])
 test('T22826', normal, compile, [''])
 test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimod_compile, ['T23573', '-v0'])
 test('T23465', normal, compile, ['-ddump-parsed'])
+test('WarnNoncanonical', normal, compile, [''])
diff --git a/testsuite/tests/wcompat-warnings/Template.hs b/testsuite/tests/wcompat-warnings/Template.hs
index 1a6c328f6c0428406fe0d17af9b0f7148b9f7ee7..3cd0ee34afdd30f2e331b8fb4dcf3add490450ce 100644
--- a/testsuite/tests/wcompat-warnings/Template.hs
+++ b/testsuite/tests/wcompat-warnings/Template.hs
@@ -1,28 +1,13 @@
+{-# LANGUAGE DataKinds #-}
 module WCompatWarningsOnOff where
 
-import qualified Data.Semigroup as Semi
+import Data.Proxy
+import GHC.Types
+import Data.List
+import Data.Kind
 
--- -fwarn-noncanonical-monoid-instances
-newtype S = S Int
+type T1 = 'Nothing :: Maybe a
 
-instance Semi.Semigroup S where
-  (<>) = mappend
-
-instance Monoid S where
-  S a `mappend` S b = S (a+b)
-  mempty = S 0
-
-newtype M a = M a
-
-instance Functor M where
-  fmap = undefined
-
-instance Applicative M where
-  liftA2 = undefined
-  pure = return
-  (*>) = (>>)
-
-instance Monad M where
-  return = undefined
-  (>>=) = undefined
-  (>>) = undefined
+foo :: Maybe a -> Maybe a
+foo (Just @b x) = Just @b x
+foo _ = Nothing
diff --git a/testsuite/tests/wcompat-warnings/WCompatDefault.hs b/testsuite/tests/wcompat-warnings/WCompatDefault.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c9816dc4f4704063c18e7be4d14c1557a0d94c19
--- /dev/null
+++ b/testsuite/tests/wcompat-warnings/WCompatDefault.hs
@@ -0,0 +1,26 @@
+module Main where
+
+-- base
+import Data.List
+  ( intersect )
+import System.Exit
+  ( exitFailure, exitSuccess )
+
+-- ghc
+import GHC.Driver.Flags
+  ( standardWarnings, minusWcompatOpts )
+
+--------------------------------------------------------------------------------
+
+-- Test that there are no warning flags in both the -Wcompat and -Wdefault
+-- warning groups.
+
+main :: IO ()
+main = do
+  case minusWcompatOpts `intersect` standardWarnings of
+    [] -> exitSuccess
+    badWarnings -> do
+      putStrLn $ unlines $
+        "The following warning flags are in both -Wcompat and -Wdefault:"
+        : map (("  - " ++) . show) badWarnings
+      exitFailure
diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
index db1e5c990979db2f885657c75cdf2465013d3f93..b9b5bbe239602823102a39b6122c680a59d9b183 100644
--- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
+++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
@@ -1,45 +1,15 @@
 
-Template.hs:9:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)]
-    Noncanonical ‘(<>) = mappend’ definition detected
-    in the instance declaration for ‘Semigroup S’.
-    Suggested fix:
-      Move definition from ‘mappend’ to ‘(<>)’
-      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid
-
-Template.hs:12:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)]
-    Noncanonical ‘mappend’ definition detected
-    in the instance declaration for ‘Monoid S’.
-    ‘mappend’ will eventually be removed in favour of ‘(<>)’
-    Suggested fix:
-      Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’
-      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid
-
-Template.hs:22:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)]
-    Noncanonical ‘pure = return’ definition detected
-    in the instance declaration for ‘Applicative M’.
-    Suggested fix:
-      Move definition from ‘return’ to ‘pure’
-      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
-
-Template.hs:23:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)]
-    Noncanonical ‘(*>) = (>>)’ definition detected
-    in the instance declaration for ‘Applicative M’.
-    Suggested fix:
-      Move definition from ‘(>>)’ to ‘(*>)’
-      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
-
-Template.hs:26:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)]
-    Noncanonical ‘return’ definition detected
-    in the instance declaration for ‘Monad M’.
-    ‘return’ will eventually be removed in favour of ‘pure’
-    Suggested fix:
-      Either remove definition for ‘return’ (recommended) or define as ‘return = pure’
-      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
-
-Template.hs:28:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)]
-    Noncanonical ‘(>>)’ definition detected
-    in the instance declaration for ‘Monad M’.
-    ‘(>>)’ will eventually be removed in favour of ‘(*>)’
-    Suggested fix:
-      Either remove definition for ‘(>>)’ (recommended) or define as ‘(>>) = (*>)’
-      See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
+Template.hs:6:8: warning: [GHC-82347] [-Wcompat-unqualified-imports (in -Wcompat)]
+    To ensure compatibility with future core libraries changes
+    imports to Data.List should be
+    either qualified or have an explicit import list.
+
+Template.hs:9:29: warning: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat)]
+    The variable ‘a’ occurs free on the RHS of the type declaration
+    In the future GHC will no longer implicitly quantify over such variables
+    Suggested fix: Bind ‘a’ on the LHS of the type declaration
+
+Template.hs:12:6: warning: [GHC-69797] [-Wdeprecated-type-abstractions (in -Wcompat)]
+    Type applications in constructor patterns will require
+    the TypeAbstractions extension starting from GHC 9.14.
+    Suggested fix: Perhaps you intended to use TypeAbstractions
diff --git a/testsuite/tests/wcompat-warnings/all.T b/testsuite/tests/wcompat-warnings/all.T
index a472f7bf54cec732e37bdbe23f9b641500f001be..04e1c7c216809106f8e89731779472d398e1092d 100644
--- a/testsuite/tests/wcompat-warnings/all.T
+++ b/testsuite/tests/wcompat-warnings/all.T
@@ -2,3 +2,4 @@
 test('WCompatWarningsOn',    extra_files(['Template.hs']), compile, [''])
 test('WCompatWarningsOff',   extra_files(['Template.hs']), compile, [''])
 test('WCompatWarningsOnOff', extra_files(['Template.hs']), compile, [''])
+test('WCompatDefault', normal, compile_and_run, ['-package ghc'])