Refinement holes (haskell/ghcide#748)

* Refinement holes * Set more GHC options and use indentation for parsing * Add an option to customize the typed holes settings Refinement hole fits are very cool, but currently too slow to enable at deeper levels. It should eventually be user configurable. * GHC Compatibility * Compat. with 8.4
pepeiborra · Sep 5, 2020 · eb73c5f · eb73c5f
1 parent 35d11ce
commit eb73c5f
Show file tree

Hide file tree

Showing 6 changed files with 177 additions and 96 deletions.
diff --git a/ghcide.cabal b/ghcide.cabal
@@ -101,6 +101,7 @@ library
         BangPatterns
         DeriveFunctor
         DeriveGeneric
+        FlexibleContexts
         GeneralizedNewtypeDeriving
         LambdaCase
         NamedFieldPuns
@@ -224,6 +225,7 @@ benchmark benchHist
         BangPatterns
         DeriveFunctor
         DeriveGeneric
+        FlexibleContexts
         GeneralizedNewtypeDeriving
         LambdaCase
         NamedFieldPuns
@@ -291,6 +293,7 @@ executable ghcide
         BangPatterns
         DeriveFunctor
         DeriveGeneric
+        FlexibleContexts
         GeneralizedNewtypeDeriving
         LambdaCase
         NamedFieldPuns
@@ -361,6 +364,7 @@ test-suite ghcide-tests
         BangPatterns
         DeriveFunctor
         DeriveGeneric
+        FlexibleContexts
         GeneralizedNewtypeDeriving
         LambdaCase
         NamedFieldPuns
@@ -399,6 +403,7 @@ executable ghcide-bench
         BangPatterns
         DeriveFunctor
         DeriveGeneric
+        FlexibleContexts
         GeneralizedNewtypeDeriving
         LambdaCase
         NamedFieldPuns

diff --git a/session-loader/Development/IDE/Session.hs b/session-loader/Development/IDE/Session.hs
@@ -35,6 +35,7 @@ import Data.Version
 import Development.IDE.Core.OfInterest
 import Development.IDE.Core.Shake
 import Development.IDE.Core.RuleTypes
+import Development.IDE.GHC.Compat
 import Development.IDE.GHC.Util
 import Development.IDE.Session.VersionCheck
 import Development.IDE.Types.Diagnostics
@@ -56,7 +57,6 @@ import System.FilePath
 import System.Info
 import System.IO
 
-import GHC
 import GHCi
 import DynFlags
 import HscTypes
@@ -106,7 +106,10 @@ loadSession dir = do
                        withIndefiniteProgress, ideNc, knownFilesVar
                       } <- getShakeExtras
 
-    IdeOptions{optTesting = IdeTesting optTesting, optCheckProject = CheckProject checkProject } <- getIdeOptions
+    IdeOptions{ optTesting = IdeTesting optTesting
+              , optCheckProject = CheckProject checkProject
+              , optCustomDynFlags
+              } <- getIdeOptions
 
     -- Create a new HscEnv from a hieYaml root and a set of options
     -- If the hieYaml file already has an HscEnv, the new component is
@@ -118,7 +121,7 @@ loadSession dir = do
           -- Parse DynFlags for the newly discovered component
           hscEnv <- emptyHscEnv ideNc libDir
           (df, targets) <- evalGhcEnv hscEnv $
-              setOptions opts (hsc_dflags hscEnv)
+              first optCustomDynFlags <$> setOptions opts (hsc_dflags hscEnv)
           let deps = componentDependencies opts ++ maybeToList hieYaml
           dep_info <- getDependencyInfo deps
           -- Now lookup to see whether we are combining with an existing HscEnv
@@ -182,7 +185,7 @@ loadSession dir = do
                 -> IO ([NormalizedFilePath],(IdeResult HscEnvEq,[FilePath]))
         session args@(hieYaml, _cfp, _opts, _libDir) = do
           (hscEnv, new, old_deps) <- packageSetup args
-          
+
           -- Whenever we spin up a session on Linux, dynamically load libm.so.6
           -- in. We need this in case the binary is statically linked, in which
           -- case the interactive session will fail when trying to load
@@ -197,7 +200,7 @@ loadSession dir = do
             case res of
               Nothing -> pure ()
               Just err -> hPutStrLn stderr $
-                "Error dynamically loading libm.so.6:\n" <> err 
+                "Error dynamically loading libm.so.6:\n" <> err
 
           -- Make a map from unit-id to DynFlags, this is used when trying to
           -- resolve imports. (especially PackageImports)
@@ -576,6 +579,7 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
           setIgnoreInterfacePragmas $
           setLinkerOptions $
           disableOptimisation $
+          setUpTypedHoles $
           makeDynFlagsAbsolute compRoot dflags'
     -- initPackages parses the -package flags and
     -- sets up the visibility for each component.

diff --git a/src/Development/IDE/GHC/Compat.hs b/src/Development/IDE/GHC/Compat.hs
@@ -31,6 +31,7 @@ module Development.IDE.GHC.Compat(
     addIncludePathsQuote,
     getModuleHash,
     getPackageName,
+    setUpTypedHoles,
     pattern DerivD,
     pattern ForD,
     pattern InstD,
@@ -325,6 +326,31 @@ dontWriteHieFiles d =
     d
 #endif
 
+setUpTypedHoles ::DynFlags -> DynFlags
+#if MIN_GHC_API_VERSION(8,6,0)
+setUpTypedHoles df
+  = flip gopt_unset Opt_AbstractRefHoleFits    -- too spammy
+#if MIN_GHC_API_VERSION(8,8,0)
+  $ flip gopt_unset Opt_ShowDocsOfHoleFits     -- not used
+#endif
+  $ flip gopt_unset Opt_ShowMatchesOfHoleFits  -- nice but broken (forgets module qualifiers)
+  $ flip gopt_unset Opt_ShowProvOfHoleFits     -- not used
+  $ flip gopt_unset Opt_ShowTypeAppOfHoleFits  -- not used
+  $ flip gopt_unset Opt_ShowTypeAppVarsOfHoleFits -- not used
+  $ flip gopt_unset Opt_ShowTypeOfHoleFits     -- massively simplifies parsing
+  $ flip gopt_set   Opt_SortBySubsumHoleFits   -- very nice and fast enough in most cases
+  $ flip gopt_unset Opt_SortValidHoleFits
+  $ flip gopt_unset Opt_UnclutterValidHoleFits
+  $ df
+  { refLevelHoleFits = Just 1   -- becomes slow at higher levels
+  , maxRefHoleFits   = Just 10  -- quantity does not impact speed
+  , maxValidHoleFits = Nothing  -- quantity does not impact speed
+  }
+#else
+setUpTypedHoles = id
+#endif
+
+
 nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
 nameListFromAvails as =
   map (\n -> (nameSrcSpan n, n)) (concatMap availNames as)