Disallow -XDerivingVia when -XSafe is on (#19786)

Since `GeneralizedNewtypeDeriving` is considered unsafe, `DerivingVia`
should be as well.

(cherry picked from commit 0281dae8b3fe3384939c415ae72ca2440b3cafb3)

4 files changed, 23 insertions, 1 deletions

diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index ba957a9bd7..ec8a933d39 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -591,6 +591,7 @@ data DynFlags = DynFlags {
   -- them.
   thOnLoc               :: SrcSpan,
   newDerivOnLoc         :: SrcSpan,
+  deriveViaOnLoc        :: SrcSpan,
   overlapInstLoc        :: SrcSpan,
   incoherentOnLoc       :: SrcSpan,
   pkgTrustOnLoc         :: SrcSpan,
@@ -1206,6 +1207,7 @@ defaultDynFlags mySettings llvmConfig =
         safeInferred = True,
         thOnLoc = noSrcSpan,
         newDerivOnLoc = noSrcSpan,
+        deriveViaOnLoc = noSrcSpan,
         overlapInstLoc = noSrcSpan,
         incoherentOnLoc = noSrcSpan,
         pkgTrustOnLoc = noSrcSpan,
@@ -1630,6 +1632,9 @@ unsafeFlags, unsafeFlagsForInfer
 unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
                     xopt LangExt.GeneralizedNewtypeDeriving,
                     flip xopt_unset LangExt.GeneralizedNewtypeDeriving)
+              , ("-XDerivingVia", deriveViaOnLoc,
+                    xopt LangExt.DerivingVia,
+                    flip xopt_unset LangExt.DerivingVia)
               , ("-XTemplateHaskell", thOnLoc,
                     xopt LangExt.TemplateHaskell,
                     flip xopt_unset LangExt.TemplateHaskell)
@@ -3497,7 +3502,8 @@ xFlagsDeps = [
   flagSpec "DeriveLift"                       LangExt.DeriveLift,
   flagSpec "DeriveTraversable"                LangExt.DeriveTraversable,
   flagSpec "DerivingStrategies"               LangExt.DerivingStrategies,
-  flagSpec "DerivingVia"                      LangExt.DerivingVia,
+  flagSpec' "DerivingVia"                     LangExt.DerivingVia
+                                              setDeriveVia,
   flagSpec "DisambiguateRecordFields"         LangExt.DisambiguateRecordFields,
   flagSpec "DoAndIfThenElse"                  LangExt.DoAndIfThenElse,
   flagSpec "BlockArguments"                   LangExt.BlockArguments,
@@ -4097,6 +4103,10 @@ setGenDeriving :: TurnOnFlag -> DynP ()
 setGenDeriving True  = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l })
 setGenDeriving False = return ()
 
+setDeriveVia :: TurnOnFlag -> DynP ()
+setDeriveVia True  = getCurLoc >>= \l -> upd (\d -> d { deriveViaOnLoc = l })
+setDeriveVia False = return ()
+
 setOverlappingInsts :: TurnOnFlag -> DynP ()
 setOverlappingInsts False = return ()
 setOverlappingInsts True = do
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs
new file mode 100644
index 0000000000..915876a838
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE Safe, DerivingVia #-}
+
+-- | Tests that Safe disables DerivingVia (#19786)
+module SafeLang19 where
+
+f :: Int
+f = 1
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr
new file mode 100644
index 0000000000..1dbe65d156
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr
@@ -0,0 +1,3 @@
+
+SafeLang19.hs:2:20: warning:
+    -XDerivingVia is not allowed in Safe Haskell; ignoring -XDerivingVia
diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T
index de4a9b6908..ac15d88a21 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/all.T
+++ b/testsuite/tests/safeHaskell/safeLanguage/all.T
@@ -32,6 +32,7 @@ test('SafeLang16', normal, compile, [''])
 test('SafeLang17', [], multimod_compile_fail, ['SafeLang17', ''])
 
 test('SafeLang18', normal, compile, [''])
+test('SafeLang19', normal, compile, [''])
 
 # Test building a package, that trust values are set correctly
 # and can be changed correctly