Defer type errors (#47)

* TEST: Degrade type error to warning

It will be upgraded again later, but for the time being we want to see
whether the proposed mechanism for deferring type errors works at
all. As it turns out the first, most obvious approach, does not
work: this is documented in the next commit.

A second approach was found that does work, and appears in the commit
after the next.

This test is failing until the second approach is implemented.

* Defer type errors (first approach: FAILED)

The idea is to set the `-fdefer-type-errors` and
`-fwarn-deferred-type-errors` flags, by setting options
programatically inside the `Ghc` monad.

Deferral of type errors was not observed with this approach. The
(less obvious) approach used in the next commit seems to be more
successful.

* Defer type errors (second approach: SUCCESS)

This approach modifies the `ParsedModule` which is passed to
`GHC.typecheckedModule` by hie-core's `typecheckModule`.

Type warning deferral is now observed at run time, and the tests pass.

* TEST: Reinstate severity of type errors

So far, type errors have been deferred and reported as warnings.

The next step is to ensure that the deferred type errors are reported
as errors rather than warnings, once again. This test fails until the
implementation arrives in the next commit.

* Upgrade severity of deferred Type Errors after typecheck

... and make the test pass again.

* Hide helper functions in local scopes

* Stop setting Opt_WarnDeferredTypeErrors

... and the tests still pass, thereby confirming @hsenag's hypothesis
that this flag is not needed.

* TEST: Check that typed holes are reported as errors

* TEST: Downgrade severity of typed holes Error -> Warning

This test fails, thereby falsifying the hypothesis that
`Opt_DeferTypeErrors` implies `Opt_DeferTypedHoles`.

* Defer typed holes

... and pass the failing test.

* TEST: Reinstate severity of typed holes

... failing the test until the implementation catches up in the next
commit.

* Upgrade severity of deferred Typed Holes after typecheck

... and pass the test once again.

* TEST: Degrade variable out of scope from Error to Warning

... test fails until next commit.

* Defer out of scope variables

... passing the test which was changed in the last commit.

* TEST: Reinstate severity of out of scope variables

... failing the test, and forcing the implementation to catch up.

* Upgrade severity of deferred out of scope vars after typecheck

... passing the test once again.

* Add explicit tests for deferrals

* Add IdeOption for deferral switching

* Improve documentation of optDefer

* Add IdeDefer newtype

Author: jacg

src/Development/IDE/Core/Compile.hs

@@ -82,19 +82,22 @@ computePackageDeps env pkg = do
 
 -- | Typecheck a single module using the supplied dependencies and packages.
 typecheckModule
-    :: HscEnv
+    :: IdeDefer
+    -> HscEnv
     -> [TcModuleResult]
     -> ParsedModule
     -> IO ([FileDiagnostic], Maybe TcModuleResult)
-typecheckModule packageState deps pm =
+typecheckModule (IdeDefer defer) packageState deps pm =
+    let demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id
+    in
     fmap (either (, Nothing) (second Just)) $
     runGhcEnv packageState $
         catchSrcErrors "typecheck" $ do
             setupEnv deps
             (warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
-                GHC.typecheckModule pm{pm_mod_summary = tweak $ pm_mod_summary pm}
+                GHC.typecheckModule $ demoteIfDefer pm{pm_mod_summary = tweak $ pm_mod_summary pm}
             tcm2 <- mkTcModuleResult tcm
-            return (warnings, tcm2)
+            return (map unDefer warnings, tcm2)
 
 -- | Compile a single type-checked module to a 'CoreModule' value, or
 -- provide errors.
@@ -126,8 +129,32 @@ compileModule packageState deps tmr =
                          (cg_binds tidy)
                          (mg_safe_haskell desugar)
 
-            return (warnings, core)
+            return (map snd warnings, core)
+
+demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule
+demoteTypeErrorsToWarnings =
+  (update_pm_mod_summary . update_hspp_opts) demoteTEsToWarns where
+
+  demoteTEsToWarns :: DynFlags -> DynFlags
+  demoteTEsToWarns = (`gopt_set` Opt_DeferTypeErrors)
+                   . (`gopt_set` Opt_DeferTypedHoles)
+                   . (`gopt_set` Opt_DeferOutOfScopeVariables)
+
+  update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary
+  update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms}
+
+  update_pm_mod_summary :: (ModSummary -> ModSummary) -> ParsedModule -> ParsedModule
+  update_pm_mod_summary up pm =
+    pm{pm_mod_summary = up $ pm_mod_summary pm}
+
+unDefer :: (WarnReason, FileDiagnostic) -> FileDiagnostic
+unDefer (Reason Opt_WarnDeferredTypeErrors         , fd) = upgradeWarningToError fd
+unDefer (Reason Opt_WarnTypedHoles                 , fd) = upgradeWarningToError fd
+unDefer (Reason Opt_WarnDeferredOutOfScopeVariables, fd) = upgradeWarningToError fd
+unDefer ( _                                        , fd) = fd
 
+upgradeWarningToError :: FileDiagnostic -> FileDiagnostic
+upgradeWarningToError (nfp, fd) = (nfp, fd{_severity = Just DsError})
 
 addRelativeImport :: ParsedModule -> DynFlags -> DynFlags
 addRelativeImport modu dflags = dflags

src/Development/IDE/Core/Rules.hs

@@ -312,7 +312,8 @@ typeCheckRule =
         tms <- uses_ TypeCheck (transitiveModuleDeps deps)
         setPriority priorityTypeCheck
         packageState <- hscEnv <$> use_ GhcSession file
-        liftIO $ typecheckModule packageState tms pm
+        IdeOptions{ optDefer = defer} <- getIdeOptions
+        liftIO $ typecheckModule defer packageState tms pm
 
 
 generateCoreRule :: Rules ()

src/Development/IDE/GHC/Warnings.hs

@@ -25,14 +25,14 @@ import           Development.IDE.GHC.Error
 --   https://github.com/ghc/ghc/blob/5f1d949ab9e09b8d95319633854b7959df06eb58/compiler/main/GHC.hs#L623-L640
 --   which basically says that log_action is taken from the ModSummary when GHC feels like it.
 --   The given argument lets you refresh a ModSummary log_action
-withWarnings :: GhcMonad m => T.Text -> ((ModSummary -> ModSummary) -> m a) -> m ([FileDiagnostic], a)
+withWarnings :: GhcMonad m => T.Text -> ((ModSummary -> ModSummary) -> m a) -> m ([(WarnReason, FileDiagnostic)], a)
 withWarnings diagSource action = do
   warnings <- liftIO $ newVar []
   oldFlags <- getDynFlags
   let newAction :: DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-      newAction dynFlags _ _ loc style msg = do
-        let d = diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc (queryQual style) msg
-        modifyVar_ warnings $ return . (d:)
+      newAction dynFlags wr _ loc style msg = do
+        let wr_d = fmap (wr,) $ diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc (queryQual style) msg
+        modifyVar_ warnings $ return . (wr_d:)
   setLogAction newAction
   res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = newAction}}
   setLogAction $ log_action oldFlags

src/Development/IDE/Types/Options.hs

@@ -7,6 +7,7 @@
 module Development.IDE.Types.Options
   ( IdeOptions(..)
   , IdeReportProgress(..)
+  , IdeDefer(..)
   , clientSupportsProgress
   , IdePkgLocationOptions(..)
   , defaultIdeOptions
@@ -44,9 +45,16 @@ data IdeOptions = IdeOptions
     -- ^ the ```language to use
   , optNewColonConvention :: Bool
     -- ^ whether to use new colon convention
+  , optDefer :: IdeDefer
+    -- ^ Whether to defer type errors, typed holes and out of scope
+    --   variables. Deferral allows the IDE to continue to provide
+    --   features such as diagnostics and go-to-definition, in
+    --   situations in which they would become unavailable because of
+    --   the presence of type errors, holes or unbound variables.
   }
 
 newtype IdeReportProgress = IdeReportProgress Bool
+newtype IdeDefer          = IdeDefer          Bool
 
 clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress
 clientSupportsProgress caps = IdeReportProgress $ fromMaybe False $
@@ -63,6 +71,7 @@ defaultIdeOptions session = IdeOptions
     ,optReportProgress = IdeReportProgress False
     ,optLanguageSyntax = "haskell"
     ,optNewColonConvention = False
+    ,optDefer = IdeDefer True
     }
 
 

test/exe/Main.hs

@@ -85,6 +85,43 @@ diagnosticTests = testGroup "diagnostics"
           , [(DsError, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
           )
         ]
+  , testSession "typed hole" $ do
+      let content = T.unlines
+            [ "module Testing where"
+            , "foo :: Int -> String"
+            , "foo a = _ a"
+            ]
+      _ <- openDoc' "Testing.hs" "haskell" content
+      expectDiagnostics
+        [ ( "Testing.hs"
+          , [(DsError, (2, 8), "Found hole: _ :: Int -> String")]
+          )
+        ]
+
+  , testGroup "deferral" $
+    let sourceA a = T.unlines
+          [ "module A where"
+          , "a :: Int"
+          , "a = " <> a]
+        sourceB = T.unlines
+          [ "module B where"
+          , "import A"
+          , "b :: Float"
+          , "b = True"]
+        bMessage = "Couldn't match expected type 'Float' with actual type 'Bool'"
+        expectedDs aMessage =
+          [ ("A.hs", [(DsError, (2,4), aMessage)])
+          , ("B.hs", [(DsError, (3,4), bMessage)])]
+        deferralTest title binding message = testSession title $ do
+          _ <- openDoc' "A.hs" "haskell" $ sourceA binding
+          _ <- openDoc' "B.hs" "haskell"   sourceB
+          expectDiagnostics $ expectedDs message
+    in
+    [ deferralTest "type error"       "True"    "Couldn't match expected type"
+    , deferralTest "typed hole"       "_"       "Found hole"
+    , deferralTest "out of scope var" "unbound" "Variable not in scope"
+    ]
+
   , testSession "remove required module" $ do
       let contentA = T.unlines [ "module ModuleA where" ]
       docA <- openDoc' "ModuleA.hs" "haskell" contentA