Add HoleFitPlugins and RawHoleFitswip/D5373

This patch adds a new kind of plugin, Hole fit plugins. These plugins
can change what candidates are considered when looking for valid hole
fits, and add hole fits of their own. The type of a plugin is relatively
simple,

```
type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit]
type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate]
data HoleFitPlugin = HoleFitPlugin { candPlugin :: CandPlugin
                                   , fitPlugin :: FitPlugin }

data TypedHole = TyH { tyHRelevantCts :: Cts
                       -- ^ Any relevant Cts to the hole
                     , tyHImplics :: [Implication]
                       -- ^ The nested implications of the hole with the
                       --   innermost implication first.
                     , tyHCt :: Maybe Ct
                       -- ^ The hole constraint itself, if available.
                     }

This allows users and plugin writers to interact with the candidates and
fits as they wish, even going as far as to allow them to reimplement the
current functionality (since `TypedHole` contains all the relevant
information).

As an example, consider the following plugin:

```
module HolePlugin where

import GhcPlugins

import TcHoleErrors

import Data.List (intersect, stripPrefix)
import RdrName (importSpecModule)

import TcRnTypes

import System.Process

plugin :: Plugin
plugin = defaultPlugin { holeFitPlugin = hfp, pluginRecompile = purePlugin }

hfp :: [CommandLineOption] -> Maybe HoleFitPluginR
hfp opts = Just (fromPureHFPlugin $ HoleFitPlugin (candP opts) (fp opts))

toFilter :: Maybe String -> Maybe String
toFilter = flip (>>=) (stripPrefix "_module_")

replace :: Eq a => a -> a -> [a] -> [a]
replace match repl str = replace' [] str
  where
    replace' sofar (x:xs) | x == match = replace' (repl:sofar) xs
    replace' sofar (x:xs) = replace' (x:sofar) xs
    replace' sofar [] = reverse sofar

-- | This candidate plugin filters the candidates by module,
--   using the name of the hole as module to search in
candP :: [CommandLineOption] -> CandPlugin
candP _ hole cands =
  do let he = case tyHCt hole of
                Just (CHoleCan _ h) -> Just (occNameString $ holeOcc h)
                _ -> Nothing
     case toFilter he of
        Just undscModName -> do let replaced = replace '_' '.' undscModName
                                let res = filter (greNotInOpts [replaced]) cands
                                return $ res
        _ -> return cands
  where greNotInOpts opts (GreHFCand gre)  = not $ null $ intersect (inScopeVia gre) opts
        greNotInOpts _ _ = True
        inScopeVia = map (moduleNameString . importSpecModule) . gre_imp

-- Yes, it's pretty hacky, but it is just an example :)
searchHoogle :: String -> IO [String]
searchHoogle ty = lines <$> (readProcess "hoogle" [(show ty)] [])

fp :: [CommandLineOption] -> FitPlugin
fp ("hoogle":[]) hole hfs =
    do dflags <- getDynFlags
       let tyString = showSDoc dflags . ppr . ctPred <$> tyHCt hole
       res <- case tyString of
                Just ty -> liftIO $ searchHoogle ty
                _ -> return []
       return $ (take 2 $ map (RawHoleFit . text . ("Hoogle says: " ++)) res) ++ hfs
fp _ _ hfs = return hfs

```

with this plugin available, you can compile the following file

```
{-# OPTIONS -fplugin=HolePlugin -fplugin-opt=HolePlugin:hoogle #-}
module Main where

import Prelude hiding (head, last)

import Data.List (head, last)

t :: [Int] -> Int
t = _module_Prelude

g :: [Int] -> Int
g = _module_Data_List

main :: IO ()
main = print $ t [1,2,3]
```

and get the following output:

```
Main.hs:14:5: error:
    • Found hole: _module_Prelude :: [Int] -> Int
      Or perhaps ‘_module_Prelude’ is mis-spelled, or not in scope
    • In the expression: _module_Prelude
      In an equation for ‘t’: t = _module_Prelude
    • Relevant bindings include
        t :: [Int] -> Int (bound at Main.hs:14:1)
      Valid hole fits include
        Hoogle says: GHC.List length :: [a] -> Int
        Hoogle says: GHC.OldList length :: [a] -> Int
        t :: [Int] -> Int (bound at Main.hs:14:1)
        g :: [Int] -> Int (bound at Main.hs:17:1)
        length :: forall (t :: * -> *) a. Foldable t => t a -> Int
          with length @[] @Int
          (imported from ‘Prelude’ at Main.hs:5:1-34
           (and originally defined in ‘Data.Foldable’))
        maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
          with maximum @[] @Int
          (imported from ‘Prelude’ at Main.hs:5:1-34
           (and originally defined in ‘Data.Foldable’))
        (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
   |
14 | t = _module_Prelude
   |     ^^^^^^^^^^^^^^^

Main.hs:17:5: error:
    • Found hole: _module_Data_List :: [Int] -> Int
      Or perhaps ‘_module_Data_List’ is mis-spelled, or not in scope
    • In the expression: _module_Data_List
      In an equation for ‘g’: g = _module_Data_List
    • Relevant bindings include
        g :: [Int] -> Int (bound at Main.hs:17:1)
      Valid hole fits include
        Hoogle says: GHC.List length :: [a] -> Int
        Hoogle says: GHC.OldList length :: [a] -> Int
        g :: [Int] -> Int (bound at Main.hs:17:1)
        head :: forall a. [a] -> a
          with head @Int
          (imported from ‘Data.List’ at Main.hs:7:19-22
           (and originally defined in ‘GHC.List’))
        last :: forall a. [a] -> a
          with last @Int
          (imported from ‘Data.List’ at Main.hs:7:25-28
           (and originally defined in ‘GHC.List’))
   |
17 | g = _module_Data_List

```

This relatively simple plugin has two functions, as an example of what
is possible to do with hole fit plugins. The candidate plugin starts by
filtering the candidates considered by module, indicated by the name of
the hole (`_module_Data_List`). The second function is in the fit
plugin, where the plugin invokes a local hoogle instance to search by
the type of the hole.

By adding the `RawHoleFit` type, we can also allow these completely free
suggestions, used in the plugin above to display fits found by Hoogle.

Additionally, the `HoleFitPluginR` wrapper can be used for plugins to
maintain state between invocations, which can be used to speed up
invocation of plugins that have expensive initialization.

```
-- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can
-- track internal state. Note the existential quantification, ensuring that
-- the state cannot be modified from outside the plugin.
data HoleFitPluginR = forall s. HoleFitPluginR
  { hfPluginInit :: TcM (TcRef s)
    -- ^ Initializes the TcRef to be passed to the plugin
  , hfPluginRun :: TcRef s -> HoleFitPlugin
    -- ^ The function defining the plugin itself
  , hfPluginStop :: TcRef s -> TcM ()
    -- ^ Cleanup of state, guaranteed to be called even on error
  }
```

Of course, the syntax here is up for debate, but hole fit plugins allow
us to experiment relatively easily with ways to interact with
typed-holes without having to dig deep into GHC.

Reviewers: bgamari

Subscribers: rwbarton, carter

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

8 files changed, 323 insertions, 164 deletions

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 1a235c4008..35810cc7c5 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -521,6 +521,7 @@ Library
         TcRules
         TcSimplify
         TcHoleErrors
+        TcHoleFitTypes
         TcErrors
         TcTyClsDecls
         TcTyDecls
diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
index 93297522db..26bd41fd08 100644
--- a/compiler/main/Plugins.hs
+++ b/compiler/main/Plugins.hs
@@ -30,6 +30,10 @@ module Plugins (
       -- - access to loaded interface files with 'interfaceLoadAction'
       --
     , keepRenamedSource
+      -- ** Hole fit plugins
+      -- | hole fit plugins allow plugins to change the behavior of valid hole
+      -- fit suggestions
+    , HoleFitPluginR
 
       -- * Internal
     , PluginWithArgs(..), plugins, pluginRecompile'
@@ -42,7 +46,8 @@ import GhcPrelude
 
 import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM )
 import qualified TcRnTypes
-import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports )
+import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports  )
+import TcHoleFitTypes ( HoleFitPluginR )
 import HsSyn
 import DynFlags
 import HscTypes
@@ -79,6 +84,9 @@ data Plugin = Plugin {
   , tcPlugin :: TcPlugin
     -- ^ An optional typechecker plugin, which may modify the
     -- behaviour of the constraint solver.
+  , holeFitPlugin :: HoleFitPlugin
+    -- ^ An optional plugin to handle hole fits, which may re-order
+    --   or change the list of valid hole fits and refinement hole fits.
   , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
     -- ^ Specify how the plugin should affect recompilation.
   , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule
@@ -169,6 +177,7 @@ instance Monoid PluginRecompile where
 
 type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
 type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin
+type HoleFitPlugin = [CommandLineOption] -> Maybe HoleFitPluginR
 
 purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile
 purePlugin _args = return NoForceRecompile
@@ -186,7 +195,8 @@ defaultPlugin :: Plugin
 defaultPlugin = Plugin {
         installCoreToDos      = const return
       , tcPlugin              = const Nothing
-      , pluginRecompile  = impurePlugin
+      , holeFitPlugin         = const Nothing
+      , pluginRecompile       = impurePlugin
       , renamedResultAction   = \_ env grp -> return (env, grp)
       , parsedResultAction    = \_ _ -> return
       , typeCheckResultAction = \_ _ -> return
diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs
index a5a4cf28d4..8c9cf0285b 100644
--- a/compiler/typecheck/TcHoleErrors.hs
+++ b/compiler/typecheck/TcHoleErrors.hs
@@ -1,6 +1,18 @@
-module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits, HoleFit (..)
-                    , HoleFitCandidate (..), tcCheckHoleFit, tcSubsumes
-                    , withoutUnification ) where
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits
+                    , tcCheckHoleFit, tcSubsumes
+                    , withoutUnification
+                    , fromPureHFPlugin
+                    -- Re-exports for convenience
+                    , hfIsLcl
+                    , pprHoleFit, debugHoleFitDispConfig
+
+                    -- Re-exported from TcHoleFitTypes
+                    , TypedHole (..), HoleFit (..), HoleFitCandidate (..)
+                    , CandPlugin, FitPlugin
+                    , HoleFitPlugin (..), HoleFitPluginR (..)
+                    ) where
 
 import GhcPrelude
 
@@ -28,10 +40,9 @@ import FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV )
 
 import Control.Arrow ( (&&&) )
 
-import Control.Monad    ( filterM, replicateM )
+import Control.Monad    ( filterM, replicateM, foldM )
 import Data.List        ( partition, sort, sortOn, nubBy )
 import Data.Graph       ( graphFromEdges, topSort )
-import Data.Function    ( on )
 
 
 import TcSimplify    ( simpl_top, runTcSDeriveds )
@@ -39,12 +50,14 @@ import TcUnify       ( tcSubType_NC )
 
 import ExtractDocs ( extractDocs )
 import qualified Data.Map as Map
-import HsDoc           ( HsDocString, unpackHDS, DeclDocMap(..) )
+import HsDoc           ( unpackHDS, DeclDocMap(..) )
 import HscTypes        ( ModIface(..) )
 import LoadIface       ( loadInterfaceForNameMaybe )
 
 import PrelInfo (knownKeyNames)
 
+import TcHoleFitTypes
+
 
 {-
 Note [Valid hole fits include ...]
@@ -420,72 +433,6 @@ getSortingAlg =
                               then BySize
                               else NoSorting }
 
-
--- | HoleFitCandidates are passed to the filter and checked whether they can be
--- made to fit.
-data HoleFitCandidate = IdHFCand Id             -- An id, like locals.
-                      | NameHFCand Name         -- A name, like built-in syntax.
-                      | GreHFCand GlobalRdrElt  -- A global, like imported ids.
-                      deriving (Eq)
-instance Outputable HoleFitCandidate where
-  ppr = pprHoleFitCand
-
-pprHoleFitCand :: HoleFitCandidate -> SDoc
-pprHoleFitCand (IdHFCand id) = text "Id HFC: " <> ppr id
-pprHoleFitCand (NameHFCand name) = text "Name HFC: " <> ppr name
-pprHoleFitCand (GreHFCand gre) = text "Gre HFC: " <> ppr gre
-
-instance HasOccName HoleFitCandidate where
-  occName hfc = case hfc of
-                  IdHFCand id -> occName id
-                  NameHFCand name -> occName name
-                  GreHFCand gre -> occName (gre_name gre)
-
--- | HoleFit is the type we use for valid hole fits. It contains the
--- element that was checked, the Id of that element as found by `tcLookup`,
--- and the refinement level of the fit, which is the number of extra argument
--- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).
-data HoleFit =
-  HoleFit { hfId   :: Id       -- The elements id in the TcM
-          , hfCand :: HoleFitCandidate  -- The candidate that was checked.
-          , hfType :: TcType -- The type of the id, possibly zonked.
-          , hfRefLvl :: Int  -- The number of holes in this fit.
-          , hfWrap :: [TcType] -- The wrapper for the match.
-          , hfMatches :: [TcType]  -- What the refinement variables got matched
-                                   -- with, if anything
-          , hfDoc :: Maybe HsDocString } -- Documentation of this HoleFit, if
-                                         -- available.
-
-
-hfName :: HoleFit -> Name
-hfName hf = case hfCand hf of
-              IdHFCand id -> idName id
-              NameHFCand name -> name
-              GreHFCand gre -> gre_name gre
-
-hfIsLcl :: HoleFit -> Bool
-hfIsLcl hf = case hfCand hf of
-               IdHFCand _    -> True
-               NameHFCand _  -> False
-               GreHFCand gre -> gre_lcl gre
-
--- We define an Eq and Ord instance to be able to build a graph.
-instance Eq HoleFit where
-   (==) = (==) `on` hfId
-
--- We compare HoleFits by their name instead of their Id, since we don't
--- want our tests to be affected by the non-determinism of `nonDetCmpVar`,
--- which is used to compare Ids. When comparing, we want HoleFits with a lower
--- refinement level to come first.
-instance Ord HoleFit where
-  compare a b = cmp a b
-    where cmp  = if hfRefLvl a == hfRefLvl b
-                 then compare `on` hfName
-                 else compare `on` hfRefLvl
-
-instance Outputable HoleFit where
-    ppr = pprHoleFit debugHoleFitDispConfig
-
 -- If enabled, we go through the fits and add any associated documentation,
 -- by looking it up in the module or the environment (for local fits)
 addDocs :: [HoleFit] -> TcM [HoleFit]
@@ -499,70 +446,70 @@ addDocs fits =
    msg = text "TcHoleErrors addDocs"
    lookupInIface name (ModIface { mi_decl_docs = DeclDocMap dmap })
      = Map.lookup name dmap
-   upd lclDocs fit =
-     let name = hfName fit in
-     do { doc <- if hfIsLcl fit
-                 then pure (Map.lookup name lclDocs)
-                 else do { mbIface <- loadInterfaceForNameMaybe msg name
-                         ; return $ mbIface >>= lookupInIface name }
-        ; return $ fit {hfDoc = doc} }
+   upd lclDocs fit@(HoleFit {hfCand = cand}) =
+        do { let name = getName cand
+           ; doc <- if hfIsLcl fit
+                    then pure (Map.lookup name lclDocs)
+                    else do { mbIface <- loadInterfaceForNameMaybe msg name
+                            ; return $ mbIface >>= lookupInIface name }
+           ; return $ fit {hfDoc = doc} }
+   upd _ fit = return fit
 
 -- For pretty printing hole fits, we display the name and type of the fit,
 -- with added '_' to represent any extra arguments in case of a non-zero
 -- refinement level.
 pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
-pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) hf = hang display 2 provenance
-    where name = hfName hf
-          ty = hfType hf
-          matches =  hfMatches hf
-          wrap = hfWrap hf
-          tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars wrap
-            where pprArg b arg = case binderArgFlag b of
-                                   Specified -> text "@" <> pprParendType arg
-                                   -- Do not print type application for inferred
-                                   -- variables (#16456)
-                                   Inferred  -> empty
-                                   Required  -> pprPanic "pprHoleFit: bad Required"
+pprHoleFit _ (RawHoleFit sd) = sd
+pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
+ hang display 2 provenance
+ where name =  getName hfCand
+       tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars hfWrap
+         where pprArg b arg = case binderArgFlag b of
+                                Specified -> text "@" <> pprParendType arg
+                                -- Do not print type application for inferred
+                                -- variables (#16456)
+                                Inferred  -> empty
+                                Required  -> pprPanic "pprHoleFit: bad Required"
                                                          (ppr b <+> ppr arg)
-          tyAppVars = sep $ punctuate comma $
-              zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+>
-                                                 text "~" <+> pprParendType t)
-                vars wrap
-
-          vars = unwrapTypeVars ty
-            where
-              -- Attempts to get all the quantified type variables in a type,
-              -- e.g.
-              -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a)
-              -- into [m, a]
-              unwrapTypeVars :: Type -> [TyCoVarBinder]
-              unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of
-                                  Just (_, unfunned) -> unwrapTypeVars unfunned
-                                  _ -> []
-                where (vars, unforalled) = splitForAllVarBndrs t
-          holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) matches
-          holeDisp = if sMs then holeVs
-                     else sep $ replicate (length matches) $ text "_"
-          occDisp = pprPrefixOcc name
-          tyDisp = ppWhen sTy $ dcolon <+> ppr ty
-          has = not . null
-          wrapDisp = ppWhen (has wrap && (sWrp || sWrpVars))
-                      $ text "with" <+> if sWrp || not sTy
-                                        then occDisp <+> tyApp
-                                        else tyAppVars
-          docs = case hfDoc hf of
-                   Just d -> text "{-^" <>
-                             (vcat . map text . lines . unpackHDS) d
-                             <> text "-}"
-                   _ -> empty
-          funcInfo = ppWhen (has matches && sTy) $
-                       text "where" <+> occDisp <+> tyDisp
-          subDisp = occDisp <+> if has matches then holeDisp else tyDisp
-          display =  subDisp $$ nest 2 (funcInfo $+$ docs $+$ wrapDisp)
-          provenance = ppWhen sProv $ parens $
-                case hfCand hf of
-                    GreHFCand gre -> pprNameProvenance gre
-                    _ -> text "bound at" <+> ppr (getSrcLoc name)
+       tyAppVars = sep $ punctuate comma $
+           zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+>
+                                               text "~" <+> pprParendType t)
+           vars hfWrap
+
+       vars = unwrapTypeVars hfType
+         where
+           -- Attempts to get all the quantified type variables in a type,
+           -- e.g.
+           -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a)
+           -- into [m, a]
+           unwrapTypeVars :: Type -> [TyCoVarBinder]
+           unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of
+                               Just (_, unfunned) -> unwrapTypeVars unfunned
+                               _ -> []
+             where (vars, unforalled) = splitForAllVarBndrs t
+       holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches
+       holeDisp = if sMs then holeVs
+                  else sep $ replicate (length hfMatches) $ text "_"
+       occDisp = pprPrefixOcc name
+       tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
+       has = not . null
+       wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
+                   $ text "with" <+> if sWrp || not sTy
+                                     then occDisp <+> tyApp
+                                     else tyAppVars
+       docs = case hfDoc of
+                Just d -> text "{-^" <>
+                          (vcat . map text . lines . unpackHDS) d
+                          <> text "-}"
+                _ -> empty
+       funcInfo = ppWhen (has hfMatches && sTy) $
+                    text "where" <+> occDisp <+> tyDisp
+       subDisp = occDisp <+> if has hfMatches then holeDisp else tyDisp
+       display =  subDisp $$ nest 2 (funcInfo $+$ docs $+$ wrapDisp)
+       provenance = ppWhen sProv $ parens $
+             case hfCand of
+                 GreHFCand gre -> pprNameProvenance gre
+                 _ -> text "bound at" <+> ppr (getSrcLoc name)
 
 getLocalBindings :: TidyEnv -> Ct -> TcM [Id]
 getLocalBindings tidy_orig ct
@@ -598,11 +545,15 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct =
      ; maxVSubs <- maxValidHoleFits <$> getDynFlags
      ; hfdc <- getHoleFitDispConfig
      ; sortingAlg <- getSortingAlg
+     ; dflags <- getDynFlags
+     ; hfPlugs <- tcg_hf_plugins <$> getGblEnv
      ; let findVLimit = if sortingAlg > NoSorting then Nothing else maxVSubs
-     ; refLevel <- refLevelHoleFits <$> getDynFlags
-     ; traceTc "findingValidHoleFitsFor { " $ ppr ct
+           refLevel = refLevelHoleFits dflags
+           hole = TyH (listToBag relevantCts) implics (Just ct)
+           (candidatePlugins, fitPlugins) =
+             unzip $ map (\p-> ((candPlugin p) hole, (fitPlugin p) hole)) hfPlugs
+     ; traceTc "findingValidHoleFitsFor { " $ ppr hole
      ; traceTc "hole_lvl is:" $ ppr hole_lvl
-     ; traceTc "implics are: " $ ppr implics
      ; traceTc "simples are: " $ ppr simples
      ; traceTc "locals are: " $ ppr lclBinds
      ; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env)
@@ -615,11 +566,14 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct =
            globals = map GreHFCand gbl
            syntax = map NameHFCand builtIns
            to_check = locals ++ syntax ++ globals
+     ; cands <- foldM (flip ($)) to_check candidatePlugins
+     ; traceTc "numPlugins are:" $ ppr (length candidatePlugins)
      ; (searchDiscards, subs) <-
-        tcFilterHoleFits findVLimit implics relevantCts (hole_ty, []) to_check
+        tcFilterHoleFits findVLimit hole (hole_ty, []) cands
      ; (tidy_env, tidy_subs) <- zonkSubs tidy_env subs
      ; tidy_sorted_subs <- sortFits sortingAlg tidy_subs
-     ; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs tidy_sorted_subs
+     ; plugin_handled_subs <- foldM (flip ($)) tidy_sorted_subs fitPlugins
+     ; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs plugin_handled_subs
            vDiscards = pVDisc || searchDiscards
      ; subs_with_docs <- addDocs limited_subs
      ; let vMsg = ppUnless (null subs_with_docs) $
@@ -638,8 +592,8 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct =
             ; traceTc "ref_tys are" $ ppr ref_tys
             ; let findRLimit = if sortingAlg > NoSorting then Nothing
                                                          else maxRSubs
-            ; refDs <- mapM (flip (tcFilterHoleFits findRLimit implics
-                                     relevantCts) to_check) ref_tys
+            ; refDs <- mapM (flip (tcFilterHoleFits findRLimit hole)
+                              cands) ref_tys
             ; (tidy_env, tidy_rsubs) <- zonkSubs tidy_env $ concatMap snd refDs
             ; tidy_sorted_rsubs <- sortFits sortingAlg tidy_rsubs
             -- For refinement substitutions we want matches
@@ -649,8 +603,10 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct =
             ; (tidy_env, tidy_hole_ty) <- zonkTidyTcType tidy_env hole_ty
             ; let hasExactApp = any (tcEqType tidy_hole_ty) . hfWrap
                   (exact, not_exact) = partition hasExactApp tidy_sorted_rsubs
-                  (pRDisc, exact_last_rfits) =
-                    possiblyDiscard maxRSubs $ not_exact ++ exact
+            ; plugin_handled_rsubs <- foldM (flip ($))
+                                        (not_exact ++ exact) fitPlugins
+            ; let (pRDisc, exact_last_rfits) =
+                    possiblyDiscard maxRSubs $ plugin_handled_rsubs
                   rDiscards = pRDisc || any fst refDs
             ; rsubs_with_docs <- addDocs exact_last_rfits
             ; return (tidy_env,
@@ -732,6 +688,9 @@ findValidHoleFits tidy_env implics simples ct | isExprHoleCt ct =
       where zonkSubs' zs env [] = return (env, reverse zs)
             zonkSubs' zs env (hf:hfs) = do { (env', z) <- zonkSub env hf
                                            ; zonkSubs' (z:zs) env' hfs }
+
+            zonkSub :: TidyEnv -> HoleFit -> TcM (TidyEnv, HoleFit)
+            zonkSub env hf@RawHoleFit{} = return (env, hf)
             zonkSub env hf@HoleFit{hfType = ty, hfMatches = m, hfWrap = wrp}
               = do { (env, ty') <- zonkTidyTcType env ty
                    ; (env, m') <- zonkTidyTcTypes env m
@@ -786,10 +745,7 @@ findValidHoleFits env _ _ _ = return (env, empty)
 -- running the type checker. Stops after finding limit matches.
 tcFilterHoleFits :: Maybe Int
                -- ^ How many we should output, if limited
-               -> [Implication]
-               -- ^ Enclosing implications for givens
-               -> [Ct]
-               -- ^ Any relevant unsolved simple constraints
+               -> TypedHole -- ^ The hole to filter against
                -> (TcType, [TcTyVar])
                -- ^ The type to check for fits and a list of refinement
                -- variables (free type variables in the type) for emulating
@@ -799,8 +755,8 @@ tcFilterHoleFits :: Maybe Int
                -> TcM (Bool, [HoleFit])
                -- ^ We return whether or not we stopped due to hitting the limit
                -- and the fits we found.
-tcFilterHoleFits (Just 0) _ _ _ _ = return (False, []) -- Stop right away on 0
-tcFilterHoleFits limit implics relevantCts ht@(hole_ty, _) candidates =
+tcFilterHoleFits (Just 0) _ _ _ = return (False, []) -- Stop right away on 0
+tcFilterHoleFits limit (TyH {..}) ht@(hole_ty, _) candidates =
   do { traceTc "checkingFitsFor {" $ ppr hole_ty
      ; (discards, subs) <- go [] emptyVarSet limit ht candidates
      ; traceTc "checkingFitsFor }" empty
@@ -901,7 +857,7 @@ tcFilterHoleFits limit implics relevantCts ht@(hole_ty, _) candidates =
     -- refinement hole fits, so we can't wrap the side-effects deeper than this.
       withoutUnification fvs $
       do { traceTc "checkingFitOf {" $ ppr ty
-         ; (fits, wrp) <- tcCheckHoleFit (listToBag relevantCts) implics h_ty ty
+         ; (fits, wrp) <- tcCheckHoleFit hole h_ty ty
          ; traceTc "Did it fit?" $ ppr fits
          ; traceTc "wrap is: " $ ppr wrp
          ; traceTc "checkingFitOf }" empty
@@ -934,6 +890,7 @@ tcFilterHoleFits limit implics relevantCts ht@(hole_ty, _) candidates =
                           else return Nothing }
            else return Nothing }
      where fvs = mkFVs ref_vars `unionFV` hole_fvs `unionFV` tyCoFVsOfType ty
+           hole = TyH tyHRelevantCts tyHImplics Nothing
 
 
 subsDiscardMsg :: SDoc
@@ -970,8 +927,8 @@ withoutUnification free_vars action =
 -- discarding any errors. Subsumption here means that the ty_b can fit into the
 -- ty_a, i.e. `tcSubsumes a b == True` if b is a subtype of a.
 tcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool
-tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit emptyBag [] ty_a ty_b
-
+tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit dummyHole ty_a ty_b
+  where dummyHole = TyH emptyBag [] Nothing
 
 -- | A tcSubsumes which takes into account relevant constraints, to fix trac
 -- #14273. This makes sure that when checking whether a type fits the hole,
@@ -979,24 +936,22 @@ tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit emptyBag [] ty_a ty_b
 -- constraints on the type of the hole.
 -- Note: The simplifier may perform unification, so make sure to restore any
 -- free type variables to avoid side-effects.
-tcCheckHoleFit :: Cts                   -- ^  Any relevant Cts to the hole.
-               -> [Implication]
-               -- ^ The nested implications of the hole with the innermost
-               -- implication first.
-               -> TcSigmaType           -- ^ The type of the hole.
-               -> TcSigmaType           -- ^ The type to check whether fits.
+tcCheckHoleFit :: TypedHole   -- ^ The hole to check against
+               -> TcSigmaType
+               -- ^ The type to check against (possibly modified, e.g. refined)
+               -> TcSigmaType -- ^ The type to check whether fits.
                -> TcM (Bool, HsWrapper)
                -- ^ Whether it was a match, and the wrapper from hole_ty to ty.
-tcCheckHoleFit _ _ hole_ty ty | hole_ty `eqType` ty
+tcCheckHoleFit _ hole_ty ty | hole_ty `eqType` ty
     = return (True, idHsWrapper)
-tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $
+tcCheckHoleFit (TyH {..}) hole_ty ty = discardErrs $
   do { -- We wrap the subtype constraint in the implications to pass along the
        -- givens, and so we must ensure that any nested implications and skolems
        -- end up with the correct level. The implications are ordered so that
        -- the innermost (the one with the highest level) is first, so it
        -- suffices to get the level of the first one (or the current level, if
        -- there are no implications involved).
-       innermost_lvl <- case implics of
+       innermost_lvl <- case tyHImplics of
                           [] -> getTcLevel
                           -- imp is the innermost implication
                           (imp:_) -> return (ic_tclvl imp)
@@ -1004,15 +959,15 @@ tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $
                           tcSubType_NC ExprSigCtxt ty hole_ty
      ; traceTc "Checking hole fit {" empty
      ; traceTc "wanteds are: " $ ppr wanted
-     ; if isEmptyWC wanted && isEmptyBag relevantCts
+     ; if isEmptyWC wanted && isEmptyBag tyHRelevantCts
        then traceTc "}" empty >> return (True, wrp)
        else do { fresh_binds <- newTcEvBinds
                 -- The relevant constraints may contain HoleDests, so we must
                 -- take care to clone them as well (to avoid #15370).
-               ; cloned_relevants <- mapBagM cloneWanted relevantCts
+               ; cloned_relevants <- mapBagM cloneWanted tyHRelevantCts
                  -- We wrap the WC in the nested implications, see
                  -- Note [Nested Implications]
-               ; let outermost_first = reverse implics
+               ; let outermost_first = reverse tyHImplics
                      setWC = setWCAndBinds fresh_binds
                     -- We add the cloned relevants to the wanteds generated by
                     -- the call to tcSubType_NC, see Note [Relevant Constraints]
@@ -1035,3 +990,10 @@ tcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $
        setWCAndBinds binds imp wc
          = WC { wc_simple = emptyBag
               , wc_impl = unitBag $ imp { ic_wanted = wc , ic_binds = binds } }
+
+-- | Maps a plugin that needs no state to one with an empty one.
+fromPureHFPlugin :: HoleFitPlugin -> HoleFitPluginR
+fromPureHFPlugin plug =
+  HoleFitPluginR { hfPluginInit = newTcRef ()
+                 , hfPluginRun = const plug
+                 , hfPluginStop = const $ return () }
diff --git a/compiler/typecheck/TcHoleFitTypes.hs b/compiler/typecheck/TcHoleFitTypes.hs
new file mode 100644
index 0000000000..8700cc1399
--- /dev/null
+++ b/compiler/typecheck/TcHoleFitTypes.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module TcHoleFitTypes (
+  TypedHole (..), HoleFit (..), HoleFitCandidate (..),
+  CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..),
+  hfIsLcl, pprHoleFitCand
+  ) where
+
+import GhcPrelude
+
+import TcRnTypes
+import TcType
+
+import RdrName
+
+import HsDoc
+import Id
+
+import Outputable
+import Name
+
+import Data.Function ( on )
+
+data TypedHole = TyH { tyHRelevantCts :: Cts
+                       -- ^ Any relevant Cts to the hole
+                     , tyHImplics :: [Implication]
+                       -- ^ The nested implications of the hole with the
+                       --   innermost implication first.
+                     , tyHCt :: Maybe Ct
+                       -- ^ The hole constraint itself, if available.
+                     }
+
+instance Outputable TypedHole where
+  ppr (TyH rels implics ct)
+    = hang (text "TypedHole") 2
+        (ppr rels $+$ ppr implics $+$ ppr ct)
+
+
+-- | HoleFitCandidates are passed to hole fit plugins and then
+-- checked whether they fit a given typed-hole.
+data HoleFitCandidate = IdHFCand Id             -- An id, like locals.
+                      | NameHFCand Name         -- A name, like built-in syntax.
+                      | GreHFCand GlobalRdrElt  -- A global, like imported ids.
+                      deriving (Eq)
+
+instance Outputable HoleFitCandidate where
+  ppr = pprHoleFitCand
+
+pprHoleFitCand :: HoleFitCandidate -> SDoc
+pprHoleFitCand (IdHFCand cid) = text "Id HFC: " <> ppr cid
+pprHoleFitCand (NameHFCand cname) = text "Name HFC: " <> ppr cname
+pprHoleFitCand (GreHFCand cgre) = text "Gre HFC: " <> ppr cgre
+
+
+
+
+instance NamedThing HoleFitCandidate where
+  getName hfc = case hfc of
+                     IdHFCand cid -> idName cid
+                     NameHFCand cname -> cname
+                     GreHFCand cgre -> gre_name cgre
+  getOccName hfc = case hfc of
+                     IdHFCand cid -> occName cid
+                     NameHFCand cname -> occName cname
+                     GreHFCand cgre -> occName (gre_name cgre)
+
+instance HasOccName HoleFitCandidate where
+  occName = getOccName
+
+instance Ord HoleFitCandidate where
+  compare = compare `on` getName
+
+-- | HoleFit is the type we use for valid hole fits. It contains the
+-- element that was checked, the Id of that element as found by `tcLookup`,
+-- and the refinement level of the fit, which is the number of extra argument
+-- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).
+data HoleFit =
+  HoleFit { hfId   :: Id       -- ^ The elements id in the TcM
+          , hfCand :: HoleFitCandidate  -- ^ The candidate that was checked.
+          , hfType :: TcType -- ^ The type of the id, possibly zonked.
+          , hfRefLvl :: Int  -- ^ The number of holes in this fit.
+          , hfWrap :: [TcType] -- ^ The wrapper for the match.
+          , hfMatches :: [TcType]
+          -- ^ What the refinement variables got matched with, if anything
+          , hfDoc :: Maybe HsDocString
+          -- ^ Documentation of this HoleFit, if available.
+          }
+ | RawHoleFit SDoc
+ -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins
+ --   can inject any fit they want.
+
+-- We define an Eq and Ord instance to be able to build a graph.
+instance Eq HoleFit where
+   (==) = (==) `on` hfId
+
+instance Outputable HoleFit where
+  ppr (RawHoleFit sd) = sd
+  ppr (HoleFit _ cand ty _ _ mtchs _) =
+    hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty))
+    where name = ppr $ getName cand
+          holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs
+
+-- We compare HoleFits by their name instead of their Id, since we don't
+-- want our tests to be affected by the non-determinism of `nonDetCmpVar`,
+-- which is used to compare Ids. When comparing, we want HoleFits with a lower
+-- refinement level to come first.
+instance Ord HoleFit where
+  compare (RawHoleFit _) (RawHoleFit _) = EQ
+  compare (RawHoleFit _) _ = LT
+  compare _ (RawHoleFit _) = GT
+  compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b
+    where cmp  = if hfRefLvl a == hfRefLvl b
+                 then compare `on` (getName . hfCand)
+                 else compare `on` hfRefLvl
+
+hfIsLcl :: HoleFit -> Bool
+hfIsLcl hf@(HoleFit {}) = case hfCand hf of
+                            IdHFCand _    -> True
+                            NameHFCand _  -> False
+                            GreHFCand gre -> gre_lcl gre
+hfIsLcl _ = False
+
+
+-- | A plugin for modifying the candidate hole fits *before* they're checked.
+type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate]
+
+-- | A plugin for modifying hole fits  *after* they've been found.
+type FitPlugin =  TypedHole -> [HoleFit] -> TcM [HoleFit]
+
+-- | A HoleFitPlugin is a pair of candidate and fit plugins.
+data HoleFitPlugin = HoleFitPlugin
+  { candPlugin :: CandPlugin
+  , fitPlugin :: FitPlugin }
+
+-- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can
+-- track internal state. Note the existential quantification, ensuring that
+-- the state cannot be modified from outside the plugin.
+data HoleFitPluginR = forall s. HoleFitPluginR
+  { hfPluginInit :: TcM (TcRef s)
+    -- ^ Initializes the TcRef to be passed to the plugin
+  , hfPluginRun :: TcRef s -> HoleFitPlugin
+    -- ^ The function defining the plugin itself
+  , hfPluginStop :: TcRef s -> TcM ()
+    -- ^ Cleanup of state, guaranteed to be called even on error
+  }
diff --git a/compiler/typecheck/TcHoleFitTypes.hs-boot b/compiler/typecheck/TcHoleFitTypes.hs-boot
new file mode 100644
index 0000000000..fde064e51a
--- /dev/null
+++ b/compiler/typecheck/TcHoleFitTypes.hs-boot
@@ -0,0 +1,10 @@
+-- This boot file is in place to break the loop where:
+-- + TcRnTypes needs 'HoleFitPlugin',
+-- + which needs 'TcHoleFitTypes'
+-- + which needs 'TcRnTypes'
+module TcHoleFitTypes where
+
+-- Build ordering
+import GHC.Base()
+
+data HoleFitPlugin
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 3ffc5df61e..55c229766f 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -140,6 +140,9 @@ import qualified Data.Set as S
 import Control.DeepSeq
 import Control.Monad
 
+import TcHoleFitTypes ( HoleFitPluginR (..) )
+
+
 #include "HsVersions.h"
 
 {-
@@ -164,7 +167,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax
               (text "Renamer/typechecker"<+>brackets (ppr this_mod))
               (const ()) $
    initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $
-          withTcPlugins hsc_env $
+          withTcPlugins hsc_env $ withHoleFitPlugins hsc_env $
 
           tcRnModuleTcRnM hsc_env mod_sum parsedModule pair
 
@@ -1840,7 +1843,7 @@ runTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a)
 -- Initialise the tcg_inst_env with instances from all home modules.
 -- This mimics the more selective call to hptInstances in tcRnImports
 runTcInteractive hsc_env thing_inside
-  = initTcInteractive hsc_env $ withTcPlugins hsc_env $
+  = initTcInteractive hsc_env $ withTcPlugins hsc_env $ withHoleFitPlugins hsc_env $
     do { traceTc "setInteractiveContext" $
             vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt))
                  , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts)
@@ -2880,6 +2883,30 @@ withTcPlugins hsc_env m =
 getTcPlugins :: DynFlags -> [TcRnMonad.TcPlugin]
 getTcPlugins dflags = catMaybes $ mapPlugins dflags (\p args -> tcPlugin p args)
 
+
+withHoleFitPlugins :: HscEnv -> TcM a -> TcM a
+withHoleFitPlugins hsc_env m =
+  case (getHfPlugins (hsc_dflags hsc_env)) of
+    [] -> m  -- Common fast case
+    plugins -> do (plugins,stops) <- unzip `fmap` mapM startPlugin plugins
+                  -- This ensures that hfPluginStop is called even if a type
+                  -- error occurs during compilation.
+                  eitherRes <- tryM $ do
+                    updGblEnv (\e -> e { tcg_hf_plugins = plugins }) m
+                  sequence_ stops
+                  case eitherRes of
+                    Left _ -> failM
+                    Right res -> return res
+  where
+    startPlugin (HoleFitPluginR init plugin stop) =
+      do ref <- init
+         return (plugin ref, stop ref)
+
+getHfPlugins :: DynFlags -> [HoleFitPluginR]
+getHfPlugins dflags =
+  catMaybes $ mapPlugins dflags (\p args -> holeFitPlugin p args)
+
+
 runRenamerPlugin :: TcGblEnv
                  -> HsGroup GhcRn
                  -> TcM (TcGblEnv, HsGroup GhcRn)
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 9a76e9ced8..e297301b6b 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -312,6 +312,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
                 tcg_safeInfer      = infer_var,
                 tcg_dependent_files = dependent_files_var,
                 tcg_tc_plugins     = [],
+                tcg_hf_plugins     = [],
                 tcg_top_loc        = loc,
                 tcg_static_wc      = static_wc_var,
                 tcg_complete_matches = [],
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 3bd26e9f76..c8d83215fd 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -208,6 +208,8 @@ import Data.Maybe    ( mapMaybe )
 import GHCi.Message
 import GHCi.RemoteTypes
 
+import {-# SOURCE #-} TcHoleFitTypes ( HoleFitPlugin )
+
 import qualified Language.Haskell.TH as TH
 
 -- | A 'NameShape' is a substitution on 'Name's that can be used
@@ -685,6 +687,8 @@ data TcGblEnv
 
         tcg_tc_plugins :: [TcPluginSolver],
         -- ^ A list of user-defined plugins for the constraint solver.
+        tcg_hf_plugins :: [HoleFitPlugin],
+        -- ^ A list of user-defined plugins for hole fit suggestions.
 
         tcg_top_loc :: RealSrcSpan,
         -- ^ The RealSrcSpan this module came from