Show constraints when reporting typed holes
authorMaciej Bielecki <zyla@prati.pl>
Wed, 14 Dec 2016 21:43:25 +0000 (16:43 -0500)
committerBen Gamari <ben@smart-cactus.org>
Thu, 15 Dec 2016 15:42:25 +0000 (10:42 -0500)
This patch implements the display of constraints in the error message
for typed holes.

Test Plan: validate, read docs

Reviewers: simonpj, austin, bgamari

Reviewed By: simonpj, bgamari

Subscribers: simonpj, thomie

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

GHC Trac Issues: #10614

compiler/main/DynFlags.hs
compiler/typecheck/TcErrors.hs
docs/users_guide/glasgow_exts.rst
testsuite/tests/typecheck/should_compile/all.T
testsuite/tests/typecheck/should_compile/hole_constraints.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/hole_constraints.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/hole_constraints_nested.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr [new file with mode: 0644]
utils/mkUserGuidePart/Options/Verbosity.hs

index 5785184..db234bd 100644 (file)
@@ -539,6 +539,7 @@ data GeneralFlag
                     -- instead of just the start position.
    | Opt_PprCaseAsLet
    | Opt_PprShowTicks
+   | Opt_ShowHoleConstraints
 
    -- Suppress all coercions, them replacing with '...'
    | Opt_SuppressCoercions
@@ -3654,7 +3655,8 @@ fFlagsDeps = [
   flagSpec "version-macros"                   Opt_VersionMacros,
   flagSpec "worker-wrapper"                   Opt_WorkerWrapper,
   flagSpec "show-warning-groups"              Opt_ShowWarnGroups,
-  flagSpec "hide-source-paths"                Opt_HideSourcePaths
+  flagSpec "hide-source-paths"                Opt_HideSourcePaths,
+  flagSpec "show-hole-constraints"            Opt_ShowHoleConstraints
   ]
 
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
index a096db2..1720e4d 100644 (file)
@@ -1022,8 +1022,16 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole })
   -- Explicit holes, like "_" or "_f"
   = do { (ctxt, binds_msg, ct) <- relevantBindings False ctxt ct
                -- The 'False' means "don't filter the bindings"; see Trac #8191
+
+       ; show_hole_constraints <- goptM Opt_ShowHoleConstraints
+       ; let constraints_msg
+               | isExprHoleCt ct, show_hole_constraints
+                  = givenConstraintsMsg ctxt
+               | otherwise = empty
+
        ; mkErrorMsgFromCt ctxt ct $
-            important hole_msg `mappend` relevant_bindings binds_msg }
+            important hole_msg `mappend`
+            relevant_bindings (binds_msg $$ constraints_msg) }
 
   where
     occ     = holeOcc hole
@@ -1070,6 +1078,23 @@ mkHoleError ctxt ct@(CHoleCan { cc_hole = hole })
 
 mkHoleError _ ct = pprPanic "mkHoleError" (ppr ct)
 
+
+-- See Note [Constraints include ...]
+givenConstraintsMsg :: ReportErrCtxt -> SDoc
+givenConstraintsMsg ctxt =
+    let constraints :: [(Type, RealSrcSpan)]
+        constraints =
+          do { Implic{ ic_given = given, ic_env = env } <- cec_encl ctxt
+             ; constraint <- given
+             ; return (varType constraint, tcl_loc env) }
+
+        pprConstraint (constraint, loc) =
+          ppr constraint <+> nest 2 (parens (text "from" <+> ppr loc))
+
+    in ppUnless (null constraints) $
+         hang (text "Constraints include")
+            2 (vcat $ map pprConstraint constraints)
+
 pp_with_type :: OccName -> Type -> SDoc
 pp_with_type occ ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType ty)
 
@@ -1093,6 +1118,24 @@ mkIPErr ctxt cts
     (ct1:_) = cts
 
 {-
+Note [Constraints include ...]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'givenConstraintsMsg' returns the "Constraints include ..." message enabled by
+-fshow-hole-constraints. For example, the following hole:
+
+    foo :: (Eq a, Show a) => a -> String
+    foo x = _
+
+would generate the message:
+
+    Constraints include
+      Eq a (from foo.hs:1:1-36)
+      Show a (from foo.hs:1:1-36)
+
+Constraints are displayed in order from innermost (closest to the hole) to
+outermost. There's currently no filtering or elimination of duplicates.
+
+
 Note [OutOfScope exact matches]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When constructing an out-of-scope error message, we not only generate a list of
index 912f9ae..5db8bdc 100644 (file)
@@ -9696,6 +9696,33 @@ Here are some more details:
    implementation terms, they are reported by the renamer rather than
    the type checker.)
 
+There's a flag for controlling the amount of context information shown for
+typed holes:
+
+.. ghc-flag:: -fshow-hole-constraints
+
+    When reporting typed holes, also print constraints that are in scope.
+    Example: ::
+
+        f :: Eq a => a -> Bool
+        f x = _
+
+    results in the following message:
+
+    .. code-block:: none
+
+        show_constraints.hs:4:7: error:
+            • Found hole: _ :: Bool
+            • In the expression: _
+              In an equation for ‘f’: f x = _
+            • Relevant bindings include
+                x :: a (bound at show_constraints.hs:4:3)
+                f :: a -> Bool (bound at show_constraints.hs:4:1)
+              Constraints include
+                Eq a (from the type signature for:
+                             f :: Eq a => a -> Bool
+                      at show_constraints.hs:3:1-22)
+
 
 .. _partial-type-signatures:
 
index 8d25b3a..a01b018 100644 (file)
@@ -413,6 +413,8 @@ test('T7451', normal, compile, [''])
 test('holes', normal, compile, ['-fdefer-type-errors'])
 test('holes2', normal, compile, ['-fdefer-type-errors'])
 test('holes3', normal, compile_fail, [''])
+test('hole_constraints', normal, compile, ['-fdefer-type-errors'])
+test('hole_constraints_nested', normal, compile, ['-fdefer-type-errors'])
 test('T7408', normal, compile, [''])
 test('UnboxStrictPrimitiveFields', normal, compile, [''])
 test('T7541', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_compile/hole_constraints.hs b/testsuite/tests/typecheck/should_compile/hole_constraints.hs
new file mode 100644 (file)
index 0000000..dd042f3
--- /dev/null
@@ -0,0 +1,27 @@
+{-# OPTIONS_GHC -fshow-hole-constraints #-}
+{-# LANGUAGE GADTs, TypeOperators #-}
+module HoleConstraints where
+import Data.Type.Equality hiding (castWith)
+
+-- "from the signature of f1"
+f1 :: Eq a => a
+f1 = _
+
+-- "from the signature of f2", only once
+f2 :: (Show a, Eq a) => a
+f2 = _
+
+-- "from the instance declaration"
+class C a where f3 :: a
+instance Eq a => C [a] where f3 = _
+
+-- "from a pattern with constructor ... in an equation for 'castWith'"
+castWith :: a :~: b -> a -> b
+castWith Refl x = _
+
+data AnyShow where
+  AnyShow :: Show a => a -> AnyShow
+
+-- "from a pattern with constructor ... in a case alternative"
+foo :: AnyShow -> String
+foo a = case a of AnyShow x -> _
diff --git a/testsuite/tests/typecheck/should_compile/hole_constraints.stderr b/testsuite/tests/typecheck/should_compile/hole_constraints.stderr
new file mode 100644 (file)
index 0000000..1d49afa
--- /dev/null
@@ -0,0 +1,61 @@
+
+hole_constraints.hs:8:6: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: a
+      Where: ‘a’ is a rigid type variable bound by
+               the type signature for:
+                 f1 :: forall a. Eq a => a
+               at hole_constraints.hs:7:1-15
+    • In the expression: _
+      In an equation for ‘f1’: f1 = _
+    • Relevant bindings include
+        f1 :: a (bound at hole_constraints.hs:8:1)
+      Constraints include Eq a (from hole_constraints.hs:7:1-15)
+
+hole_constraints.hs:12:6: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: a
+      Where: ‘a’ is a rigid type variable bound by
+               the type signature for:
+                 f2 :: forall a. (Show a, Eq a) => a
+               at hole_constraints.hs:11:1-25
+    • In the expression: _
+      In an equation for ‘f2’: f2 = _
+    • Relevant bindings include
+        f2 :: a (bound at hole_constraints.hs:12:1)
+      Constraints include
+        Show a (from hole_constraints.hs:11:1-25)
+        Eq a (from hole_constraints.hs:11:1-25)
+
+hole_constraints.hs:16:35: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: [a]
+      Where: ‘a’ is a rigid type variable bound by
+               the instance declaration at hole_constraints.hs:16:10-22
+    • In the expression: _
+      In an equation for ‘f3’: f3 = _
+      In the instance declaration for ‘C [a]’
+    • Relevant bindings include
+        f3 :: [a] (bound at hole_constraints.hs:16:30)
+      Constraints include Eq a (from hole_constraints.hs:16:10-22)
+
+hole_constraints.hs:20:19: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: b
+      Where: ‘b’ is a rigid type variable bound by
+               the type signature for:
+                 castWith :: forall a b. (a :~: b) -> a -> b
+               at hole_constraints.hs:19:1-29
+    • In the expression: _
+      In an equation for ‘castWith’: castWith Refl x = _
+    • Relevant bindings include
+        x :: a (bound at hole_constraints.hs:20:15)
+        castWith :: (a :~: b) -> a -> b (bound at hole_constraints.hs:20:1)
+      Constraints include b ~ a (from hole_constraints.hs:20:10-13)
+
+hole_constraints.hs:27:32: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: String
+    • In the expression: _
+      In a case alternative: AnyShow x -> _
+      In the expression: case a of { AnyShow x -> _ }
+    • Relevant bindings include
+        x :: a (bound at hole_constraints.hs:27:27)
+        a :: AnyShow (bound at hole_constraints.hs:27:5)
+        foo :: AnyShow -> String (bound at hole_constraints.hs:27:1)
+      Constraints include Show a (from hole_constraints.hs:27:19-27)
diff --git a/testsuite/tests/typecheck/should_compile/hole_constraints_nested.hs b/testsuite/tests/typecheck/should_compile/hole_constraints_nested.hs
new file mode 100644 (file)
index 0000000..c8a0a01
--- /dev/null
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -fshow-hole-constraints #-}
+{-# LANGUAGE GADTs, TypeOperators #-}
+module HoleConstraintsNested where
+import Data.Type.Equality
+
+data EqOrd a where EqOrd :: (Eq a, Ord a) => EqOrd a
+
+f :: a :~: b -> EqOrd a -> Int
+f d1 d2 =
+  case d1 of
+    Refl -> case d2 of
+      EqOrd -> _
diff --git a/testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr b/testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr
new file mode 100644 (file)
index 0000000..b41aec8
--- /dev/null
@@ -0,0 +1,15 @@
+
+hole_constraints_nested.hs:12:16: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: Int
+    • In the expression: _
+      In a case alternative: EqOrd -> _
+      In the expression: case d2 of { EqOrd -> _ }
+    • Relevant bindings include
+        d2 :: EqOrd a (bound at hole_constraints_nested.hs:9:6)
+        d1 :: a :~: b (bound at hole_constraints_nested.hs:9:3)
+        f :: (a :~: b) -> EqOrd a -> Int
+          (bound at hole_constraints_nested.hs:9:1)
+      Constraints include
+        Eq a (from hole_constraints_nested.hs:12:7-11)
+        Ord a (from hole_constraints_nested.hs:12:7-11)
+        b ~ a (from hole_constraints_nested.hs:11:5-8)
index bbcaf3c..c67fa74 100644 (file)
@@ -77,4 +77,8 @@ verbosityOptions =
            "Summarise timing stats for GHC (same as ``+RTS -tstderr``)."
          , flagType = DynamicFlag
          }
+  , flag { flagName = "-fshow-hole-constraints"
+         , flagDescription = "Show constraints when reporting typed holes"
+         , flagType = DynamicFlag
+         }
   ]