Add -fno-safe-haskell flag

Summary:
This flag can be set to turn off the Safe Haskell checks.

Whether a module is marked Safe/Unsafe/Trustworthy is ignored when
this flag to set.

Reviewers: bgamari

Subscribers: rwbarton, carter

GHC Trac Issues: #15920

Differential Revision: https://phabricator.haskell.org/D5360

7 files changed, 47 insertions, 5 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2b1992274b..ef2489fb11 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -74,7 +74,8 @@ module DynFlags (
 
         -- ** Safe Haskell
         SafeHaskellMode(..),
-        safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
+        safeHaskellOn, safeHaskellModeEnabled,
+        safeImportsOn, safeLanguageOn, safeInferOn,
         packageTrustOn,
         safeDirectImpsReq, safeImplicitImpsReq,
         unsafeFlags, unsafeFlagsForInfer,
@@ -840,6 +841,7 @@ data SafeHaskellMode
    | Sf_Unsafe
    | Sf_Trustworthy
    | Sf_Safe
+   | Sf_Ignore
    deriving (Eq)
 
 instance Show SafeHaskellMode where
@@ -847,6 +849,7 @@ instance Show SafeHaskellMode where
     show Sf_Unsafe       = "Unsafe"
     show Sf_Trustworthy  = "Trustworthy"
     show Sf_Safe         = "Safe"
+    show Sf_Ignore       = "Ignore"
 
 instance Outputable SafeHaskellMode where
     ppr = text . show
@@ -2377,7 +2380,12 @@ packageTrustOn = gopt Opt_PackageTrust
 
 -- | Is Safe Haskell on in some way (including inference mode)
 safeHaskellOn :: DynFlags -> Bool
-safeHaskellOn dflags = safeHaskell dflags /= Sf_None || safeInferOn dflags
+safeHaskellOn dflags = safeHaskellModeEnabled dflags || safeInferOn dflags
+
+safeHaskellModeEnabled :: DynFlags -> Bool
+safeHaskellModeEnabled dflags = safeHaskell dflags `elem` [Sf_Unsafe, Sf_Trustworthy
+                                                   , Sf_Safe ]
+
 
 -- | Is the Safe Haskell safe language in use
 safeLanguageOn :: DynFlags -> Bool
@@ -2426,6 +2434,7 @@ safeImplicitImpsReq d = safeLanguageOn d
 combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
 combineSafeFlags a b | a == Sf_None         = return b
                      | b == Sf_None         = return a
+                     | a == Sf_Ignore || b == Sf_Ignore = return Sf_Ignore
                      | a == b               = return a
                      | otherwise            = addErr errm >> pure a
     where errm = "Incompatible Safe Haskell flags! ("
@@ -2762,7 +2771,7 @@ safeFlagCheck cmdl dflags =
     -- dynflags and warn for when -fpackage-trust by itself with no safe
     -- haskell flag
     (dflags', warn)
-      | safeHaskell dflags == Sf_None && not cmdl && packageTrustOn dflags
+      | not (safeHaskellModeEnabled dflags) && not cmdl && packageTrustOn dflags
       = (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg)
       | otherwise = (dflags, [])
 
@@ -3614,6 +3623,7 @@ dynamic_flags_deps = [
   , make_ord_flag defFlag "fpackage-trust"   (NoArg setPackageTrust)
   , make_ord_flag defFlag "fno-safe-infer"   (noArg (\d ->
                                                     d { safeInfer = False }))
+  , make_ord_flag defFlag "fno-safe-haskell" (NoArg (setSafeHaskell Sf_Ignore))
   , make_ord_flag defGhcFlag "fPIC"          (NoArg (setGeneralFlag Opt_PIC))
   , make_ord_flag defGhcFlag "fno-PIC"       (NoArg (unSetGeneralFlag Opt_PIC))
   , make_ord_flag defGhcFlag "fPIE"          (NoArg (setGeneralFlag Opt_PIC))
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 837e903631..69187627d9 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1003,7 +1003,7 @@ checkSafeImports tcg_env
     pkgTrustReqs :: DynFlags -> Set InstalledUnitId -> Set InstalledUnitId ->
           Bool -> ImportAvails
     pkgTrustReqs dflags req inf infPassed | safeInferOn dflags
-                                  && safeHaskell dflags == Sf_None && infPassed
+                                  && not (safeHaskellModeEnabled dflags) && infPassed
                                    = emptyImportAvails {
                                        imp_trust_pkgs = req `S.union` inf
                                    }
@@ -1096,6 +1096,7 @@ hscCheckSafe' m l = do
     -- otherwise we check the package trust flag.
     packageTrusted :: DynFlags -> SafeHaskellMode -> Bool -> Module -> Bool
     packageTrusted _ Sf_None      _ _ = False -- shouldn't hit these cases
+    packageTrusted _ Sf_Ignore    _ _ = False -- shouldn't hit these cases
     packageTrusted _ Sf_Unsafe    _ _ = False -- prefer for completeness.
     packageTrusted dflags _ _ _
         | not (packageTrustOn dflags) = True
@@ -1164,7 +1165,7 @@ markUnsafeInfer tcg_env whyUnsafe = do
     -- NOTE: Only wipe trust when not in an explicitly safe haskell mode. Other
     -- times inference may be on but we are in Trustworthy mode -- so we want
     -- to record safe-inference failed but not wipe the trust dependencies.
-    case safeHaskell dflags == Sf_None of
+    case not (safeHaskellModeEnabled dflags) of
       True  -> return $ tcg_env { tcg_imports = wiped_trust }
       False -> return tcg_env
 
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index bb89c58344..ef5987561f 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -2919,6 +2919,7 @@ trustInfoToNum it
             Sf_Unsafe       -> 1
             Sf_Trustworthy  -> 2
             Sf_Safe         -> 3
+            Sf_Ignore       -> 0
 
 numToTrustInfo :: Word8 -> IfaceTrustInfo
 numToTrustInfo 0 = setSafeMode Sf_None
@@ -2932,6 +2933,7 @@ numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")
 
 instance Outputable IfaceTrustInfo where
     ppr (TrustInfo Sf_None)          = text "none"
+    ppr (TrustInfo Sf_Ignore)        = text "none"
     ppr (TrustInfo Sf_Unsafe)        = text "unsafe"
     ppr (TrustInfo Sf_Trustworthy)   = text "trustworthy"
     ppr (TrustInfo Sf_Safe)          = text "safe"
diff --git a/docs/users_guide/safe_haskell.rst b/docs/users_guide/safe_haskell.rst
index adf70d2a90..d5ce08b1cf 100644
--- a/docs/users_guide/safe_haskell.rst
+++ b/docs/users_guide/safe_haskell.rst
@@ -206,6 +206,11 @@ run the plugin, it calls ``RIO.runRIO Danger.runMe`` within the ``IO``
 monad. The application is safe in the knowledge that the only ``IO`` to
 ensue will be to files whose paths were approved by the ``pathOK`` test.
 
+The Safe Haskell checks can be disabled for a module by passing the
+:ghc-flag:`-fno-safe-haskell` flag. This is useful in particular when compiling
+with source plugins as running a plugin marks the module as unsafe and can then
+cause downstream modules to fail the safety checks.
+
 .. _safe-language:
 
 Safe Language
@@ -710,6 +715,18 @@ In summary, Safe Haskell consists of the following three language flags:
     - *Imported Modules* — Under control of module author which ones must be
       trusted.
 
+A flag to disable Safe Haskell checks:
+
+.. ghc-flag:: -fno-safe-haskell
+    :shortdesc: Disable :ref:`Safe Haskell <safe-haskell>`
+    :type: dynamic
+    :category: packages
+
+    This flag can be enabled to overwrite any declared safety property of the module
+    (Safe, Unsafe, Trustworthy) so compilation proceeds as if none of these
+    flags were specified. This is particularlly useful when running plugins which
+    automatically mark each module as unsafe.
+
 And one general flag:
 
 .. ghc-flag:: -fpackage-trust
diff --git a/testsuite/tests/safeHaskell/flags/SafeIgnore.hs b/testsuite/tests/safeHaskell/flags/SafeIgnore.hs
new file mode 100644
index 0000000000..8c2ee88c37
--- /dev/null
+++ b/testsuite/tests/safeHaskell/flags/SafeIgnore.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE Safe #-}
+module SafeIgnore where
+
+import SafeIgnoreA
+
+foo = ()
diff --git a/testsuite/tests/safeHaskell/flags/SafeIgnoreA.hs b/testsuite/tests/safeHaskell/flags/SafeIgnoreA.hs
new file mode 100644
index 0000000000..52ed7192a4
--- /dev/null
+++ b/testsuite/tests/safeHaskell/flags/SafeIgnoreA.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE Unsafe #-}
+module SafeIgnoreA where
+
+qux = ()
diff --git a/testsuite/tests/safeHaskell/flags/all.T b/testsuite/tests/safeHaskell/flags/all.T
index 0fa30e5628..3a22a210ad 100644
--- a/testsuite/tests/safeHaskell/flags/all.T
+++ b/testsuite/tests/safeHaskell/flags/all.T
@@ -63,3 +63,5 @@ test('Flags01', normal, compile, ['-XSafe'])
 test('Flags02', normal, compile, ['-XSafe'])
 
 test('SafeFlags30', normal, compile_fail, [''])
+
+test('SafeIgnore', normal, multimod_compile, ['SafeIgnore', '-v0', '-fno-safe-haskell'])