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, 218 insertions, 0 deletions

diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile
index f58a771ef9..46ef8cb3eb 100644
--- a/testsuite/tests/plugins/Makefile
+++ b/testsuite/tests/plugins/Makefile
@@ -130,3 +130,7 @@ T16104:
 T16260:
 	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin
 	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin -fplugin-trustworthy
+
+.PHONY: HoleFitPlugin
+HoleFitPlugin:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 HoleFitPlugin.hs -package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf
diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index aea3748767..a4273f5ae8 100644
--- a/testsuite/tests/plugins/all.T
+++ b/testsuite/tests/plugins/all.T
@@ -200,8 +200,16 @@ test('T16104',
       ],
      makefile_test, [])
 
+
 test('T16260',
      [extra_files(['simple-plugin/']),
       pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T16260 TOP={top}')
       ],
      makefile_test, [])
+
+test('test-hole-plugin',
+     [extra_files(['hole-fit-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C hole-fit-plugin package.hole-fit-plugin TOP={top}'),
+      extra_hc_opts('-package-db hole-fit-plugin/pkg.hole-fit-plugin/local.package.conf '+ config.plugin_way_flags)
+      ],
+     compile, ['-fdefer-typed-holes'])
diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal
new file mode 100644
index 0000000000..344fccf461
--- /dev/null
+++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.cabal
@@ -0,0 +1,11 @@
+name: HoleFitPlugin
+cabal-version: >= 1.24
+build-type: Simple
+version: 1.0.0
+
+
+library
+  default-language: Haskell2010
+  build-depends: base, ghc, time
+  exposed-modules: HoleFitPlugin
+  ghc-options: -Wall
diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
new file mode 100644
index 0000000000..dc6e9762f5
--- /dev/null
+++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE TypeApplications, RecordWildCards #-}
+module HoleFitPlugin where
+
+import GhcPlugins hiding ((<>))
+
+import TcHoleErrors
+
+import Data.List (stripPrefix, sortOn)
+
+import TcRnTypes
+
+import TcRnMonad
+
+import Text.Read
+
+
+
+data HolePluginState = HPS { holesChecked :: Int
+                           , holesLimit :: Maybe Int}
+
+bumpHolesChecked :: HolePluginState -> HolePluginState
+bumpHolesChecked (HPS h l) = HPS (h + 1) l
+
+initPlugin :: [CommandLineOption] -> TcM (TcRef HolePluginState)
+initPlugin [limit] = newTcRef $ HPS 0 $
+  case readMaybe @Int limit of
+      Just number ->  Just number
+      _ -> error $ "Invalid argument to plugin: " <> show limit
+initPlugin _ = newTcRef $ HPS 0 Nothing
+
+fromModule :: HoleFitCandidate -> [String]
+fromModule (GreHFCand gre) =
+  map (moduleNameString . importSpecModule) $ gre_imp gre
+fromModule _ = []
+
+toHoleFitCommand :: TypedHole -> String -> Maybe String
+toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h)} str
+    = stripPrefix ("_" <> str) $ occNameString $ holeOcc h
+toHoleFitCommand _ _ = Nothing
+
+
+-- | This candidate plugin filters the candidates by module,
+--   using the name of the hole as module to search in
+modFilterTimeoutP :: [CommandLineOption] -> TcRef HolePluginState -> CandPlugin
+modFilterTimeoutP _ ref hole cands = do
+  updTcRef ref bumpHolesChecked
+  HPS {..} <- readTcRef ref
+  return $ case holesLimit of
+    -- If we're out of checks, remove any candidates, so nothing is checked.
+    Just limit | holesChecked > limit -> []
+    _ -> case toHoleFitCommand hole "only_" of
+           Just modName -> filter (inScopeVia modName) cands
+           _ -> cands
+  where inScopeVia modNameStr cand@(GreHFCand _) =
+          elem (toModName modNameStr) $ fromModule cand
+        inScopeVia _ _ = False
+        toModName = replace '_' '.'
+        replace :: Eq a => a -> a -> [a] -> [a]
+        replace _ _ [] = []
+        replace a b (x:xs) = (if x == a then b else x):replace a b xs
+
+
+modSortP :: [CommandLineOption] -> TcRef HolePluginState -> FitPlugin
+modSortP _ ref hole hfs = do
+  HPS {..} <- readTcRef ref
+  return $ case holesLimit of
+    Just limit | holesChecked > limit -> [RawHoleFit $ text msg]
+    _ -> case toHoleFitCommand hole "sort_by_mod" of
+            -- If only_ is on, the fits will all be from the same module.
+           Just ('_':'d':'e':'s':'c':_) -> reverse hfs
+           Just _ -> orderByModule hfs
+           _ ->  hfs
+  where orderByModule :: [HoleFit] -> [HoleFit]
+        orderByModule = sortOn (fmap fromModule . mbHFCand)
+        mbHFCand :: HoleFit -> Maybe HoleFitCandidate
+        mbHFCand HoleFit {hfCand = c} = Just c
+        mbHFCand _ = Nothing
+        msg = "Error: Too many holes were checked, and the search aborted for"
+            <> "this hole. Try again with a higher limit."
+
+plugin :: Plugin
+plugin = defaultPlugin { holeFitPlugin = holeFitP, pluginRecompile = purePlugin}
+
+holeFitP :: [CommandLineOption] -> Maybe HoleFitPluginR
+holeFitP opts = Just (HoleFitPluginR initP pluginDef stopP)
+  where initP = initPlugin opts
+        stopP = const $ return ()
+        pluginDef ref = HoleFitPlugin { candPlugin = modFilterTimeoutP opts ref
+                                      , fitPlugin  = modSortP opts ref }
diff --git a/testsuite/tests/plugins/hole-fit-plugin/Makefile b/testsuite/tests/plugins/hole-fit-plugin/Makefile
new file mode 100644
index 0000000000..7ce5b78e75
--- /dev/null
+++ b/testsuite/tests/plugins/hole-fit-plugin/Makefile
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+	rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise,HERE))
+
+package.%:
+	$(MAKE) -s --no-print-directory clean.$*
+	mkdir pkg.$*
+	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+	"$(GHC_PKG)" init pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+	pkg.$*/setup build     --distdir pkg.$*/dist -v0
+	pkg.$*/setup install   --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/hole-fit-plugin/Setup.hs b/testsuite/tests/plugins/hole-fit-plugin/Setup.hs
new file mode 100644
index 0000000000..e8ef27dbba
--- /dev/null
+++ b/testsuite/tests/plugins/hole-fit-plugin/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/testsuite/tests/plugins/test-hole-plugin.hs b/testsuite/tests/plugins/test-hole-plugin.hs
new file mode 100644
index 0000000000..dc6b67e1d2
--- /dev/null
+++ b/testsuite/tests/plugins/test-hole-plugin.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS -fplugin=HoleFitPlugin
+            -fplugin-opt=HoleFitPlugin:4
+            -funclutter-valid-hole-fits #-}
+module Main where
+
+import Prelude hiding (head, last)
+
+import Data.List (head, last)
+
+
+f, g, h, i, j :: [Int] -> Int
+f = _too_long
+j = _
+i = _sort_by_mod_desc
+g = _only_Data_List
+h = _only_Prelude
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/plugins/test-hole-plugin.stderr b/testsuite/tests/plugins/test-hole-plugin.stderr
new file mode 100644
index 0000000000..7ca539e8d7
--- /dev/null
+++ b/testsuite/tests/plugins/test-hole-plugin.stderr
@@ -0,0 +1,66 @@
+
+test-hole-plugin.hs:12:5: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _too_long :: [Int] -> Int
+      Or perhaps ‘_too_long’ is mis-spelled, or not in scope
+    • In the expression: _too_long
+      In an equation for ‘f’: f = _too_long
+    • Relevant bindings include
+        f :: [Int] -> Int (bound at test-hole-plugin.hs:12:1)
+      Valid hole fits include
+        Error: Too many holes were checked, and the search aborted forthis hole. Try again with a higher limit.
+
+test-hole-plugin.hs:13:5: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _ :: [Int] -> Int
+    • In the expression: _
+      In an equation for ‘j’: j = _
+    • Relevant bindings include
+        j :: [Int] -> Int (bound at test-hole-plugin.hs:13:1)
+      Valid hole fits include
+        j :: [Int] -> Int
+        f :: [Int] -> Int
+        i :: [Int] -> Int
+        g :: [Int] -> Int
+        h :: [Int] -> Int
+        head :: forall a. [a] -> a
+        (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
+
+test-hole-plugin.hs:14:5: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _sort_by_mod_desc :: [Int] -> Int
+      Or perhaps ‘_sort_by_mod_desc’ is mis-spelled, or not in scope
+    • In the expression: _sort_by_mod_desc
+      In an equation for ‘i’: i = _sort_by_mod_desc
+    • Relevant bindings include
+        i :: [Int] -> Int (bound at test-hole-plugin.hs:14:1)
+      Valid hole fits include
+        sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
+        product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
+        minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
+        maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
+        length :: forall (t :: * -> *) a. Foldable t => t a -> Int
+        last :: forall a. [a] -> a
+        (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
+
+test-hole-plugin.hs:15:5: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _only_Data_List :: [Int] -> Int
+      Or perhaps ‘_only_Data_List’ is mis-spelled, or not in scope
+    • In the expression: _only_Data_List
+      In an equation for ‘g’: g = _only_Data_List
+    • Relevant bindings include
+        g :: [Int] -> Int (bound at test-hole-plugin.hs:15:1)
+      Valid hole fits include
+        head :: forall a. [a] -> a
+        last :: forall a. [a] -> a
+
+test-hole-plugin.hs:16:5: warning: [-Wtyped-holes (in -Wdefault)]
+    • Found hole: _only_Prelude :: [Int] -> Int
+      Or perhaps ‘_only_Prelude’ is mis-spelled, or not in scope
+    • In the expression: _only_Prelude
+      In an equation for ‘h’: h = _only_Prelude
+    • Relevant bindings include
+        h :: [Int] -> Int (bound at test-hole-plugin.hs:16:1)
+      Valid hole fits include
+        length :: forall (t :: * -> *) a. Foldable t => t a -> Int
+        maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
+        minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
+        product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
+        sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a