Commit 0c3341b2 authored by Maciej Bielecki's avatar Maciej Bielecki Committed by Ben Gamari

Show constraints when reporting typed holes

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
parent 52c5e553
......@@ -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\>@
......
......@@ -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
......
......@@ -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:
......
......@@ -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, [''])
......
{-# 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 -> _
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)
{-# 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 -> _
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)
......@@ -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
}
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment