GHC 8.10 support (#360)

Author: sheaf

src/Development/IDE/Core/Compile.hs

@@ -37,7 +37,10 @@ import           DynamicLoading (initializePlugins)
 import           GHC hiding (parseModule, typecheckModule)
 import qualified Parser
 import           Lexer
+#if MIN_GHC_API_VERSION(8,10,0)
+#else
 import ErrUtils
+#endif
 
 import qualified GHC
 import           GhcMonad
@@ -157,7 +160,11 @@ generateByteCode hscEnv deps tmr guts =
           setupEnv (deps ++ [tmr])
           session <- getSession
           (warnings, (_, bytecode, sptEntries)) <- withWarnings "bytecode" $ \tweak ->
-              liftIO $ hscInteractive session guts (tweak $ GHC.pm_mod_summary $ GHC.tm_parsed_module $ tmrModule tmr)
+#if MIN_GHC_API_VERSION(8,10,0)
+                liftIO $ hscInteractive session guts (GHC.ms_location $ tweak $ GHC.pm_mod_summary $ GHC.tm_parsed_module $ tmrModule tmr)
+#else
+                liftIO $ hscInteractive session guts (tweak $ GHC.pm_mod_summary $ GHC.tm_parsed_module $ tmrModule tmr)
+#endif
           let summary = pm_mod_summary $ tm_parsed_module $ tmrModule tmr
           let unlinked = BCOs bytecode sptEntries
           let linkable = LM (ms_hs_date summary) (ms_mod summary) [unlinked]
@@ -217,7 +224,11 @@ mkTcModuleResult
     -> m TcModuleResult
 mkTcModuleResult tcm = do
     session <- getSession
+#if MIN_GHC_API_VERSION(8,10,0)
+    iface <- liftIO $ mkIfaceTc session Sf_None details tcGblEnv
+#else
     (iface, _) <- liftIO $ mkIfaceTc session Nothing Sf_None details tcGblEnv
+#endif
     let mod_info = HomeModInfo iface details Nothing
     return $ TcModuleResult tcm mod_info
   where
@@ -361,8 +372,12 @@ parseFileContents
 parseFileContents customPreprocessor dflags filename contents = do
    let loc  = mkRealSrcLoc (mkFastString filename) 1 1
    case unP Parser.parseModule (mkPState dflags contents loc) of
+#if MIN_GHC_API_VERSION(8,10,0)
+     PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags
+#else
      PFailed _ locErr msgErr ->
       throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
+#endif
      POk pst rdr_module ->
          let hpm_annotations =
                (Map.fromListWith (++) $ annotations pst,

src/Development/IDE/Core/Rules.hs

@@ -253,7 +253,7 @@ reportImportCyclesRule =
 getDependenciesRule :: Rules ()
 getDependenciesRule =
     defineEarlyCutoff $ \GetDependencies file -> do
-        depInfo@DependencyInformation{..} <- use_ GetDependencyInformation file
+        depInfo <- use_ GetDependencyInformation file
         let allFiles = reachableModules depInfo
         _ <- uses_ ReportImportCycles allFiles
         opts <- getIdeOptions

src/Development/IDE/GHC/CPP.hs

@@ -59,7 +59,11 @@ doCpp dflags raw input_fn output_fn = do
     let verbFlags = getVerbFlags dflags
 
     let cpp_prog args | raw       = SysTools.runCpp dflags args
+#if MIN_GHC_API_VERSION(8,10,0)
+                      | otherwise = SysTools.runCc Nothing
+#else
                       | otherwise = SysTools.runCc
+#endif
                                           dflags (SysTools.Option "-E" : args)
 
     let target_defs =

src/Development/IDE/GHC/Util.hs

@@ -25,7 +25,7 @@ module Development.IDE.GHC.Util(
     hDuplicateTo',
     ) where
 
-import Config
+
 import Control.Concurrent
 import Data.List.Extra
 import Data.Maybe
@@ -47,7 +47,11 @@ import GHC.IO.Encoding
 import GHC.IO.Exception
 import GHC.IO.Handle.Types
 import GHC.IO.Handle.Internals
+#if MIN_GHC_API_VERSION(8,10,0)
+#else
+import Config
 import Platform
+#endif
 import Data.Unique
 import Development.Shake.Classes
 import qualified Data.Text                as T
@@ -109,17 +113,22 @@ runGhcEnv env act = do
 -- | A 'DynFlags' value where most things are undefined. It's sufficient to call pretty printing,
 --   but not much else.
 fakeDynFlags :: DynFlags
-fakeDynFlags = defaultDynFlags settings mempty
+#if MIN_GHC_API_VERSION(8,10,0)
+fakeDynFlags = unsafeGlobalDynFlags
+#else
+fakeDynFlags = defaultDynFlags
+                  settings
+                  mempty
     where
         settings = Settings
                    { sTargetPlatform = platform
                    , sPlatformConstants = platformConstants
                    , sProgramName = "ghc"
                    , sProjectVersion = cProjectVersion
 #if MIN_GHC_API_VERSION(8,6,0)
-                    , sOpt_P_fingerprint = fingerprint0
+                   , sOpt_P_fingerprint = fingerprint0
 #endif
-                    }
+                   }
         platform = Platform
           { platformWordSize=8
           , platformOS=OSUnknown
@@ -129,6 +138,7 @@ fakeDynFlags = defaultDynFlags settings mempty
           { pc_DYNAMIC_BY_DEFAULT=False
           , pc_WORD_SIZE=8
           }
+#endif
 
 -- | Given a module location, and its parse tree, figure out what is the include directory implied by it.
 --   For example, given the file @\/usr\/\Test\/Foo\/Bar.hs@ with the module name @Foo.Bar@ the directory

src/Development/IDE/LSP/Outline.hs

@@ -172,7 +172,11 @@ documentSymbolForImport (L l ImportDecl { ideclName, ideclQualified }) = Just
   (defDocumentSymbol l :: DocumentSymbol)
     { _name   = "import " <> pprText ideclName
     , _kind   = SkModule
+#if MIN_GHC_API_VERSION(8,10,0)
+    , _detail = case ideclQualified of { NotQualified -> Nothing; _ -> Just "qualified" }
+#else
     , _detail = if ideclQualified then Just "qualified" else Nothing
+#endif
     }
 #if MIN_GHC_API_VERSION(8,6,0)
 documentSymbolForImport (L _ XImportDecl {}) = Nothing

src/Development/IDE/Plugin/CodeAction.hs

@@ -77,7 +77,7 @@ codeLens _lsp ideState CodeLensParams{_textDocument=TextDocumentIdentifier uri}
         hDiag <- getHiddenDiagnostics ideState
         pure
           [ CodeLens _range (Just (Command title "typesignature.add" (Just $ List [toJSON edit]))) Nothing
-          | (dFile, _, dDiag@Diagnostic{_range=_range@Range{..},..}) <- diag ++ hDiag
+          | (dFile, _, dDiag@Diagnostic{_range=_range}) <- diag ++ hDiag
           , dFile == filePath
           , (title, tedit) <- suggestSignature False dDiag
           , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
@@ -115,7 +115,7 @@ suggestAction ideOptions parsedModule text diag = concat
 
 
 suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
-suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _  HsModule{hsmodImports}} contents Diagnostic{_range=_range@Range{..},..}
+suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _  HsModule{hsmodImports}} contents Diagnostic{_range=_range,..}
 --     The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
     | Just [_, bindings] <- matchRegex _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
     , Just (L _ impDecl) <- find (\(L l _) -> srcSpanToRange l == _range ) hsmodImports
@@ -133,7 +133,7 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _  HsModule{hsmod
     | otherwise = []
 
 suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
-suggestReplaceIdentifier contents Diagnostic{_range=_range@Range{..},..}
+suggestReplaceIdentifier contents Diagnostic{_range=_range,..}
 -- File.hs:52:41: error:
 --     * Variable not in scope:
 --         suggestAcion :: Maybe T.Text -> Range -> Range
@@ -180,7 +180,7 @@ newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ
 
 
 suggestFillTypeWildcard :: Diagnostic -> [(T.Text, [TextEdit])]
-suggestFillTypeWildcard Diagnostic{_range=_range@Range{..},..}
+suggestFillTypeWildcard Diagnostic{_range=_range,..}
 -- Foo.hs:3:8: error:
 --     * Found type wildcard `_' standing for `p -> p1 -> p'
 
@@ -191,7 +191,7 @@ suggestFillTypeWildcard Diagnostic{_range=_range@Range{..},..}
     | otherwise = []
 
 suggestAddExtension :: Diagnostic -> [(T.Text, [TextEdit])]
-suggestAddExtension Diagnostic{_range=_range@Range{..},..}
+suggestAddExtension Diagnostic{_range=_range,..}
 -- File.hs:22:8: error:
 --     Illegal lambda-case (use -XLambdaCase)
 -- File.hs:22:6: error:
@@ -221,7 +221,7 @@ ghcExtensions :: Map.HashMap T.Text Extension
 ghcExtensions = Map.fromList . map ( ( T.pack . flagSpecName ) &&& flagSpecFlag ) $ xFlags
 
 suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]
-suggestModuleTypo Diagnostic{_range=_range@Range{..},..}
+suggestModuleTypo Diagnostic{_range=_range,..}
 -- src/Development/IDE/Core/Compile.hs:58:1: error:
 --     Could not find module ‘Data.Cha’
 --     Perhaps you meant Data.Char (from base-4.12.0.0)
@@ -233,7 +233,7 @@ suggestModuleTypo Diagnostic{_range=_range@Range{..},..}
     | otherwise = []
 
 suggestFillHole :: Diagnostic -> [(T.Text, [TextEdit])]
-suggestFillHole Diagnostic{_range=_range@Range{..},..}
+suggestFillHole Diagnostic{_range=_range,..}
 --  ...Development/IDE/LSP/CodeAction.hs:103:9: warning:
 --   * Found hole: _ :: Int -> String
 --   * In the expression: _

src/Development/IDE/Plugin/Completions/Logic.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+#include "ghc-api-version.h"
 -- Mostly taken from "haskell-ide-engine"
 module Development.IDE.Plugin.Completions.Logic (
   CachedCompletions
@@ -25,6 +26,12 @@ import Type
 import Var
 import Packages
 import DynFlags
+#if MIN_GHC_API_VERSION(8,10,0)
+import Predicate (isDictTy)
+import GHC.Platform
+import Pair
+import Coercion
+#endif
 
 import Language.Haskell.LSP.Types
 import Language.Haskell.LSP.Types.Capabilities
@@ -169,7 +176,12 @@ getArgText typ = argText
               then getArgs ret
               else Prelude.filter (not . isDictTy) args
       | isPiTy t = getArgs $ snd (splitPiTys t)
+#if MIN_GHC_API_VERSION(8,10,0)
+      | Just (Pair _ t) <- coercionKind <$> isCoercionTy_maybe t
+      = getArgs t
+#else
       | isCoercionTy t = maybe [] (getArgs . snd) (splitCoercionType_maybe t)
+#endif
       | otherwise = []
 
 mkModCompl :: T.Text -> CompletionItem
@@ -387,7 +399,11 @@ getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importabl
 
 -- The supported languages and extensions
 languagesAndExts :: [T.Text]
+#if MIN_GHC_API_VERSION(8,10,0)
+languagesAndExts = map T.pack $ DynFlags.supportedLanguagesAndExtensions ( PlatformMini ArchUnknown OSUnknown )
+#else
 languagesAndExts = map T.pack DynFlags.supportedLanguagesAndExtensions
+#endif
 
 -- ---------------------------------------------------------------------
 -- helper functions for pragmas