From cc2e13b5eff1c0581fac992ed0ed842db92b8d06 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 26 Aug 2021 14:41:04 +0200 Subject: [PATCH 01/22] Drop ghc-api-compat from dependency closure Requires re-structuring GHC API Compatibility. We try to go with the latest GHC API and provide backwards compatible functions for older GHC versions. The intention is that ghcide code is written with the latest GHC API in mind, older GHC versions may have inefficiencies in order to satisfy the newer API. This way dropping support for older GHC versions is trivial (only delete a couple of '#if ... #endif' and maybe update some imports), and ghcide does suffer less from bit-rot. Additionally, we want to have the latest and best GHC API, not some semi-outdated frankenstein. The implementation adds a new Compat sub-hierarchy that defines backwards compatible functions for the GHC API, where possible higher-level abstractions. The module hierarchy re-organisation of GHC is taken care of by 'Development.IDE.GHC.Compat.Core', which takes care of almost every definition used by ghcide. If this becomes to unwieldy, it makes sense to split it up into smaller logical pieces. --- cabal-ghc901.project | 12 + cabal-ghc921.project | 125 +++ ghcide/.ghci | 29 - ghcide/bench/example/HLS | 1 - ghcide/ghcide.cabal | 12 + .../session-loader/Development/IDE/Session.hs | 74 +- ghcide/src/Development/IDE/Core/Actions.hs | 13 +- ghcide/src/Development/IDE/Core/Compile.hs | 153 ++-- .../src/Development/IDE/Core/Preprocessor.hs | 84 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 7 - ghcide/src/Development/IDE/Core/Rules.hs | 43 +- ghcide/src/Development/IDE/Core/Shake.hs | 9 +- ghcide/src/Development/IDE/Core/UseStale.hs | 8 +- ghcide/src/Development/IDE/GHC/CPP.hs | 199 +---- ghcide/src/Development/IDE/GHC/Compat.hs | 481 ++++-------- ghcide/src/Development/IDE/GHC/Compat/CPP.hs | 194 +++++ ghcide/src/Development/IDE/GHC/Compat/Core.hs | 740 ++++++++++++++++++ ghcide/src/Development/IDE/GHC/Compat/Env.hs | 207 +++++ .../src/Development/IDE/GHC/Compat/Iface.hs | 42 + .../src/Development/IDE/GHC/Compat/Logger.hs | 43 + .../Development/IDE/GHC/Compat/Outputable.hs | 173 ++++ .../src/Development/IDE/GHC/Compat/Parser.hs | 107 +++ .../src/Development/IDE/GHC/Compat/Plugins.hs | 48 ++ .../src/Development/IDE/GHC/Compat/Units.hs | 317 ++++++++ ghcide/src/Development/IDE/GHC/Error.hs | 58 +- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 6 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 34 +- ghcide/src/Development/IDE/GHC/Util.hs | 92 ++- ghcide/src/Development/IDE/GHC/Warnings.hs | 14 +- .../src/Development/IDE/Import/FindImports.hs | 49 +- ghcide/src/Development/IDE/LSP/Outline.hs | 38 +- .../src/Development/IDE/Plugin/CodeAction.hs | 46 +- .../IDE/Plugin/CodeAction/ExactPrint.hs | 7 +- .../src/Development/IDE/Plugin/Completions.hs | 6 - .../IDE/Plugin/Completions/Logic.hs | 18 +- .../IDE/Plugin/Completions/Types.hs | 2 +- ghcide/src/Development/IDE/Plugin/Test.hs | 1 - .../src/Development/IDE/Plugin/TypeLenses.hs | 20 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 48 +- ghcide/src/Development/IDE/Spans/Common.hs | 22 +- .../Development/IDE/Spans/Documentation.hs | 30 +- .../Development/IDE/Spans/LocalBindings.hs | 9 +- ghcide/src/Development/IDE/Types/Exports.hs | 17 +- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 32 +- ghcide/src/Development/IDE/Types/Location.hs | 8 +- ghcide/src/Development/IDE/Types/Options.hs | 4 +- hls-plugin-api/src/Ide/Types.hs | 2 +- 47 files changed, 2614 insertions(+), 1070 deletions(-) create mode 100644 cabal-ghc921.project delete mode 100644 ghcide/.ghci delete mode 120000 ghcide/bench/example/HLS create mode 100644 ghcide/src/Development/IDE/GHC/Compat/CPP.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Core.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Env.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Iface.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Logger.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Outputable.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Parser.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Plugins.hs create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Units.hs diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 4ef97612d0..0d2585d979 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -39,6 +39,18 @@ source-repository-package tag: b6245884ae83e00dd2b5261762549b37390179f8 -- https://github.com/lspitzner/czipwith/pull/2 +-- Head of hie-bios +source-repository-package + type: git + location: https://github.com/mpickering/hie-bios + tag: 1875bff093983a0506f80e214eda27e7419da3bc + +-- Head of hiedb +source-repository-package + type: git + location: https://github.com/wz1000/HieDb + tag: 45c4671db2da8ce5cd11e964573846cfbf3bbec8 + source-repository-package type: git location: https://github.com/anka-213/th-extras diff --git a/cabal-ghc921.project b/cabal-ghc921.project new file mode 100644 index 0000000000..1253bb17ab --- /dev/null +++ b/cabal-ghc921.project @@ -0,0 +1,125 @@ +packages: + ./ + ./hie-compat + ./shake-bench + ./hls-graph + ./ghcide + ./hls-plugin-api + ./hls-test-utils + -- ./plugins/hls-tactics-plugin + -- ./plugins/hls-brittany-plugin + -- ./plugins/hls-stylish-haskell-plugin + -- ./plugins/hls-fourmolu-plugin + ./plugins/hls-class-plugin + ./plugins/hls-eval-plugin + ./plugins/hls-explicit-imports-plugin + ./plugins/hls-refine-imports-plugin + ./plugins/hls-hlint-plugin + ./plugins/hls-retrie-plugin + ./plugins/hls-haddock-comments-plugin + -- ./plugins/hls-splice-plugin + ./plugins/hls-floskell-plugin + ./plugins/hls-pragmas-plugin + ./plugins/hls-module-name-plugin + ./plugins/hls-ormolu-plugin + ./plugins/hls-call-hierarchy-plugin + ../../../head.hackage/packages/th-extras-0.0.0.4 + +tests: true + +package * + ghc-options: -haddock + test-show-details: direct + +source-repository-package + type: git + location: https://github.com/jwaldmann/blaze-textual.git + tag: d8ee6cf80e27f9619d621c936bb4bda4b99a183f + -- https://github.com/jwaldmann/blaze-textual/commit/d8ee6cf80e27f9619d621c936bb4bda4b99a183f + -- https://github.com/bos/blaze-textual/issues/13 + +source-repository-package + type: git + location: https://github.com/mithrandi/czipwith.git + tag: b6245884ae83e00dd2b5261762549b37390179f8 + -- https://github.com/lspitzner/czipwith/pull/2 + +source-repository-package + type: git + location: https://github.com/alanz/ghc-exactprint + tag: 9f20a4e880b9e81369e0d2024e60ae02c158c57c +-- https://github.com/alanz/ghc-exactprint/pull/101 + +-- benchmark dependency +source-repository-package + type: git + location: https://github.com/HeinrichApfelmus/operational + tag: 16e19aaf34e286f3d27b3988c61040823ec66537 + +-- Head of hie-bios +source-repository-package + type: git + location: https://github.com/mpickering/hie-bios + tag: 1875bff093983a0506f80e214eda27e7419da3bc + +-- Head of hiedb +source-repository-package + type: git + location: https://github.com/wz1000/HieDb + tag: 45c4671db2da8ce5cd11e964573846cfbf3bbec8 + +write-ghc-environment-files: never + +index-state: 2021-08-17T02:21:16Z + +constraints: + -- These plugins doesn't work on GHC9 yet + haskell-language-server -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy + + +allow-newer: + -- -- Broken on ghc9, but let's pretend it's not so we can build the other things + -- brittany:base, + -- brittany:ghc, + -- brittany:ghc-boot-th, + -- butcher:base, + -- fourmolu:ghc-lib-parser, + -- stylish-haskell:ghc-lib-parser, + -- stylish-haskell:Cabal, + -- multistate:base, + -- ghc-source-gen:ghc, + + assoc:base, + cryptohash-md5:base, + cryptohash-sha1:base, + constraints-extras:template-haskell, + data-tree-print:base, + deepseq:base, + dependent-sum:some, + dependent-sum:constraints, + diagrams-postscript:base, + diagrams-postscript:lens, + diagrams-postscript:diagrams-core, + diagrams-postscript:monoid-extras, + diagrams:diagrams-core, + Chart-diagrams:diagrams-core, + SVGFonts:diagrams-core, + dual-tree:base, + -- Does this make any sense? + entropy:Cabal, + force-layout:base, + force-layout:lens, + floskell:ghc-prim, + floskell:base, + hashable:base, + hslogger:base, + monoid-extras:base, + newtype-generics:base, + parallel:base, + regex-base:base, + regex-tdfa:base, + statestack:base, + svg-builder:base, + these:base, + time-compat:base + diff --git a/ghcide/.ghci b/ghcide/.ghci deleted file mode 100644 index 8eb094939e..0000000000 --- a/ghcide/.ghci +++ /dev/null @@ -1,29 +0,0 @@ -:set -Wunused-binds -Wunused-imports -Worphans -Wunused-matches -Wincomplete-patterns - -:set -XBangPatterns -:set -XDeriveFunctor -:set -XDeriveGeneric -:set -XGeneralizedNewtypeDeriving -:set -XLambdaCase -:set -XNamedFieldPuns -:set -XOverloadedStrings -:set -XRecordWildCards -:set -XScopedTypeVariables -:set -XStandaloneDeriving -:set -XTupleSections -:set -XTypeApplications -:set -XViewPatterns - -:set -package=ghc -:set -ignore-package=ghc-lib-parser -:set -DGHC_STABLE -:set -Iinclude -:set -idist/build/autogen -:set -isrc -:set -isession-loader -:set -iexe - -:set -isrc-ghc88 -:set -idist-newstyle/build/x86_64-osx/ghc-8.8.3/ghcide-0.2.0/build/autogen - -:load Main diff --git a/ghcide/bench/example/HLS b/ghcide/bench/example/HLS deleted file mode 120000 index a8a4f8c212..0000000000 --- a/ghcide/bench/example/HLS +++ /dev/null @@ -1 +0,0 @@ -../../.. \ No newline at end of file diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 5a1dca79ef..297f5346fd 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -171,6 +171,14 @@ library Development.IDE.Core.Tracing Development.IDE.Core.UseStale Development.IDE.GHC.Compat + Development.IDE.GHC.Compat.Core + Development.IDE.GHC.Compat.Env + Development.IDE.GHC.Compat.Iface + Development.IDE.GHC.Compat.Logger + Development.IDE.GHC.Compat.Outputable + Development.IDE.GHC.Compat.Parser + Development.IDE.GHC.Compat.Plugins + Development.IDE.GHC.Compat.Units Development.IDE.Core.Compile Development.IDE.GHC.Error Development.IDE.GHC.ExactPrint @@ -220,6 +228,10 @@ library if flag(ghc-patched-unboxed-bytecode) cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE + if impl(ghc < 8.10) + exposed-modules: + Development.IDE.GHC.Compat.CPP + executable ghcide-test-preprocessor default-language: Haskell2010 hs-source-dirs: test/preprocessor diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index b769ed916a..dda605e22e 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -42,9 +42,12 @@ import Data.Time.Clock import Data.Version import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat hiding (Target, - TargetFile, TargetModule) -import qualified Development.IDE.GHC.Compat as GHC +import qualified Development.IDE.GHC.Compat.Core as GHC +import Development.IDE.GHC.Compat.Core hiding (Target, + TargetFile, TargetModule, Var) +import Development.IDE.GHC.Compat.Units (UnitId) +import Development.IDE.GHC.Compat.Env hiding (Logger) +import qualified Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Util import Development.IDE.Graph (Action) import Development.IDE.Session.VersionCheck @@ -71,12 +74,6 @@ import System.Info import Control.Applicative (Alternative ((<|>))) import Control.Exception (evaluate) import Data.Void -import GHCi -import HscTypes (hsc_IC, hsc_NC, - hsc_dflags, ic_dflags) -import Linker -import Module -import NameCache import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TQueue @@ -105,7 +102,7 @@ data SessionLoadingOptions = SessionLoadingOptions , getCacheDirs :: String -> [String] -> IO CacheDirs -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags' , getInitialGhcLibDir :: FilePath -> IO (Maybe LibDir) - , fakeUid :: GHC.InstalledUnitId + , fakeUid :: UnitId -- ^ unit id used to tag the internal component built by ghcide -- To reuse external interface files the unit ids must match, -- thus make sure to build them with `--this-unit-id` set to the @@ -118,7 +115,7 @@ instance Default SessionLoadingOptions where ,loadCradle = loadWithImplicitCradle ,getCacheDirs = getCacheDirsDefault ,getInitialGhcLibDir = getInitialGhcLibDirDefault - ,fakeUid = GHC.toInstalledUnitId (GHC.stringToUnit "main") + ,fakeUid = Compat.toUnitId (Compat.stringToUnit "main") } -- | Find the cradle for a given 'hie.yaml' configuration. @@ -195,7 +192,7 @@ runWithDb fp k = do getHieDbLoc :: FilePath -> IO FilePath getHieDbLoc dir = do - let db = intercalate "-" [dirHash, takeBaseName dir, ghcVersionStr, hiedbDataVersion] <.> "hiedb" + let db = intercalate "-" [dirHash, takeBaseName dir, Compat.ghcVersionStr, hiedbDataVersion] <.> "hiedb" dirHash = B.unpack $ B16.encode $ H.hash $ B.pack dir cDir <- IO.getXdgDirectory IO.XdgCache cacheDir createDirectoryIfMissing True cDir @@ -297,7 +294,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- We will modify the unitId and DynFlags used for -- compilation but these are the true source of -- information. - new_deps = RawComponentInfo (thisInstalledUnitId df) df targets cfp opts dep_info + new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info : maybe [] snd oldDeps -- Get all the unit-ids for things in this component inplace = map rawComponentUnitId new_deps @@ -522,11 +519,11 @@ cradleToOptsAndLibDir cradle file = do emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv emptyHscEnv nc libDir = do env <- runGhc (Just libDir) getSession - when (ghcVersion < GHC90) $ + when (Compat.ghcVersion < Compat.GHC90) $ -- This causes ghc9 to crash with the error: -- Couldn't find a target code interpreter. Try with -fexternal-interpreter initDynLinker env - pure $ setNameCache nc env{ hsc_dflags = (hsc_dflags env){useUnicode = True } } + pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env) data TargetDetails = TargetDetails { @@ -571,13 +568,13 @@ newComponentCache -> Maybe FilePath -- Path to cradle -> NormalizedFilePath -- Path to file that caused the creation of this component -> HscEnv - -> [(InstalledUnitId, DynFlags)] + -> [(UnitId, DynFlags)] -> ComponentInfo -> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo)) newComponentCache logger exts cradlePath cfp hsc_env uids ci = do let df = componentDynFlags ci - let hscEnv' = hsc_env { hsc_dflags = df - , hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } } + let hscEnv' = hscSetFlags df hsc_env + { hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } } let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath henv <- newFunc hscEnv' uids @@ -676,7 +673,7 @@ type FilesMap = HM.HashMap NormalizedFilePath (Maybe FilePath) -- This is pristine information about a component data RawComponentInfo = RawComponentInfo - { rawComponentUnitId :: InstalledUnitId + { rawComponentUnitId :: UnitId -- | Unprocessed DynFlags. Contains inplace packages such as libraries. -- We do not want to use them unprocessed. , rawComponentDynFlags :: DynFlags @@ -693,14 +690,14 @@ data RawComponentInfo = RawComponentInfo -- This is processed information about the component, in particular the dynflags will be modified. data ComponentInfo = ComponentInfo - { componentUnitId :: InstalledUnitId + { componentUnitId :: UnitId -- | Processed DynFlags. Does not contain inplace packages such as local -- libraries. Can be used to actually load this Component. , componentDynFlags :: DynFlags -- | Internal units, such as local libraries, that this component -- is loaded with. These have been extracted from the original -- ComponentOptions. - , _componentInternalUnits :: [InstalledUnitId] + , _componentInternalUnits :: [UnitId] -- | All targets of this components. , componentTargets :: [GHC.Target] -- | Filepath which caused the creation of this component @@ -747,18 +744,14 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs -- tcRnImports) which assume that all modules in the HPT have the same unit -- ID. Therefore we create a fake one and give them all the same unit id. removeInplacePackages - :: InstalledUnitId -- ^ fake uid to use for our internal component - -> [InstalledUnitId] + :: UnitId -- ^ fake uid to use for our internal component + -> [UnitId] -> DynFlags - -> (DynFlags, [InstalledUnitId]) -removeInplacePackages fake_uid us df = (setThisInstalledUnitId fake_uid $ + -> (DynFlags, [UnitId]) +removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $ df { packageFlags = ps }, uids) where - (uids, ps) = partitionEithers (map go (packageFlags df)) - go p@(ExposePackage _ (UnitIdArg u) _) = if GHC.toInstalledUnitId u `elem` us - then Left (GHC.toInstalledUnitId u) - else Right p - go p = Right p + (uids, ps) = Compat.filterInplaceUnits us (packageFlags df) -- | Memoize an IO function, with the characteristics: -- @@ -790,25 +783,18 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do -- also, it can confuse the interface stale check dontWriteHieFiles $ setIgnoreInterfacePragmas $ - setLinkerOptions $ + setBytecodeLinkerOptions $ disableOptimisation $ - setUpTypedHoles $ + Compat.setUpTypedHoles $ makeDynFlagsAbsolute compRoot dflags' -- initPackages parses the -package flags and -- sets up the visibility for each component. -- Throws if a -package flag cannot be satisfied. - final_df <- liftIO $ wrapPackageSetupException $ initUnits dflags'' - return (final_df, targets) - --- we don't want to generate object code so we compile to bytecode --- (HscInterpreted) which implies LinkInMemory --- HscInterpreted -setLinkerOptions :: DynFlags -> DynFlags -setLinkerOptions df = df { - ghcLink = LinkInMemory - , hscTarget = HscNothing - , ghcMode = CompManager - } + -- TODO: this is wrong for ghc 9.2, as the UnitState is stored in UnitEnv in HscEnv, + -- which we lose here + env <- hscSetFlags dflags'' <$> getSession + final_env' <- liftIO $ wrapPackageSetupException $ Compat.initUnits env + return (hsc_dflags final_env', targets) setIgnoreInterfacePragmas :: DynFlags -> DynFlags setIgnoreInterfacePragmas df = diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index c776ff7908..5d27facf54 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -23,17 +23,12 @@ import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat hiding (TargetFile, - TargetModule, - parseModule, - typecheckModule, - writeHieFile) +import Development.IDE.GHC.Compat hiding (writeHieFile) import Development.IDE.Graph import qualified Development.IDE.Spans.AtPoint as AtPoint import Development.IDE.Types.HscEnvEq (hscEnv) import Development.IDE.Types.Location import qualified HieDb -import HscTypes (hsc_dflags) import Language.LSP.Types (DocumentHighlight (..), SymbolInformation (..)) @@ -44,7 +39,7 @@ lookupMod :: HieDbWriter -- ^ access the database -> FilePath -- ^ The `.hie` file we got from the database -> ModuleName - -> UnitId + -> Unit -> Bool -- ^ Is this file a boot file? -> MaybeT IdeAction Uri lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing @@ -64,11 +59,11 @@ getAtPoint file pos = runMaybeT $ do opts <- liftIO $ getIdeOptionsIO ide (hf, mapping) <- useE GetHieAst file - df <- hsc_dflags . hscEnv . fst <$> useE GhcSession file + env <- hscEnv . fst <$> useE GhcSession file dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useE GetDocMap file) !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) - MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap df pos' + MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap env pos' toCurrentLocations :: PositionMapping -> [Location] -> [Location] toCurrentLocations mapping = mapMaybe go diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 340b7bebd0..e257b07f6c 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -43,19 +43,19 @@ import Development.IDE.Spans.Common import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options -import Outputable hiding ((<>)) + +import Development.IDE.GHC.Compat hiding (writeHieFile, + parseModule, + loadInterface, + parseHeader) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as GHC import HieDb import Language.LSP.Types (DiagnosticTag (..)) -import DriverPhases -import DriverPipeline hiding (unP) -import HscTypes -import LoadIface (loadModuleInterface) - -import Lexer -import qualified Parser +import Control.Monad.IO.Class #if MIN_VERSION_ghc(8,10,0) import Control.DeepSeq (force, rnf) #else @@ -63,35 +63,16 @@ import Control.DeepSeq (rnf) import ErrUtils #endif -import Development.IDE.GHC.Compat hiding (parseModule, - typecheckModule, - writeHieFile) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat as GHC -import Finder -import GhcMonad -import GhcPlugins as GHC hiding (fst3, (<>)) -import Hooks -import HscMain (hscDesugar, hscGenHardCode, - hscInteractive, hscSimplify, - hscTypecheckRename, - makeSimpleDetails) -import MkIface -import StringBuffer as SB -import TcIface (typecheckIface) -import TcRnMonad hiding (newUnique) + #if MIN_VERSION_ghc(9,0,1) import GHC.Builtin.Names -import GHC.Iface.Recomp import GHC.Tc.Gen.Splice import GHC.Tc.Types.Evidence (EvBind) #else import PrelNames import TcSplice #endif -import TidyPgm -import Bag import Control.Exception (evaluate) import Control.Exception.Safe import Control.Lens hiding (List) @@ -108,13 +89,12 @@ import Data.Maybe import qualified Data.Text as T import Data.Time (UTCTime, getCurrentTime) import qualified GHC.LanguageExtensions as LangExt -import HeaderInfo -import Linker (unload) -import Maybes (orElse) import System.Directory import System.FilePath import System.IO.Extra (fixIO, newTempFileWithin) -import TcEnv (tcLookup) + +-- GHC API imports +import GHC (parsedSource, GetDocsFailure(..)) import Control.Concurrent.Extra import Control.Concurrent.STM hiding (orElse) @@ -125,7 +105,6 @@ import Data.Functor import qualified Data.HashMap.Strict as HashMap import Data.Tuple.Extra (dupe) import Data.Unique -import GHC.Fingerprint import qualified Language.LSP.Server as LSP import qualified Language.LSP.Types as LSP @@ -146,11 +125,10 @@ parseModule IdeOptions{..} env filename ms = -- | Given a package identifier, what packages does it depend on computePackageDeps :: HscEnv - -> InstalledUnitId - -> IO (Either [FileDiagnostic] [InstalledUnitId]) + -> Unit + -> IO (Either [FileDiagnostic] [UnitId]) computePackageDeps env pkg = do - let dflags = hsc_dflags env - case oldLookupInstalledPackage dflags pkg of + case lookupUnit env pkg of Nothing -> return $ Left [ideErrorText (toNormalizedFilePath' noFilePath) $ T.pack $ "unknown package: " ++ show pkg] Just pkgInfo -> return $ Right $ unitDepends pkgInfo @@ -169,7 +147,12 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do modSummary' <- initPlugins hsc modSummary (warnings, tcm) <- withWarnings "typecheck" $ \tweak -> - tcRnModule hsc keep_lbls $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'} + let + session = tweak (hscSetFlags dflags hsc) + -- TODO: maybe settings ms_hspp_opts is unnecessary? + mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session} + in + tcRnModule hsc keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} let errorPipeline = unDefer . hideDiag dflags . tagDiag diags = map errorPipeline warnings deferedError = any fst diags @@ -180,10 +163,10 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do -- | Add a Hook to the DynFlags which captures and returns the -- typechecked splices before they are run. This information -- is used for hover. -captureSplices :: DynFlags -> (DynFlags -> IO a) -> IO (a, Splices) -captureSplices dflags k = do +captureSplices :: HscEnv -> (HscEnv -> IO a) -> IO (a, Splices) +captureSplices env k = do splice_ref <- newIORef mempty - res <- k (dflags { hooks = addSpliceHook splice_ref (hooks dflags)}) + res <- k (hscSetHooks (addSpliceHook splice_ref (hsc_hooks env)) env) splices <- readIORef splice_ref return (res, splices) where @@ -217,14 +200,13 @@ captureSplices dflags k = do tcRnModule :: HscEnv -> [Linkable] -> ParsedModule -> IO TcModuleResult tcRnModule hsc_env keep_lbls pmod = do let ms = pm_mod_summary pmod - hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms } + hsc_env_tmp = hscSetFlags (ms_hspp_opts ms) hsc_env unload hsc_env_tmp keep_lbls ((tc_gbl_env, mrn_info), splices) - <- liftIO $ captureSplices (ms_hspp_opts ms) $ \dflags -> - do let hsc_env_tmp = hsc_env { hsc_dflags = dflags } - hscTypecheckRename hsc_env_tmp ms $ + <- liftIO $ captureSplices (hscSetFlags (ms_hspp_opts ms) hsc_env) $ \hsc_env_tmp -> + do hscTypecheckRename hsc_env_tmp ms $ HsParsedModule { hpm_module = parsedSource pmod, hpm_src_files = pm_extra_src_files pmod, hpm_annotations = pm_annotations pmod } @@ -235,7 +217,7 @@ tcRnModule hsc_env keep_lbls pmod = do mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult mkHiFileResultNoCompile session tcm = do - let hsc_env_tmp = session { hsc_dflags = ms_hspp_opts ms } + let hsc_env_tmp = hscSetFlags (ms_hspp_opts ms) session ms = pm_mod_summary $ tmrParsed tcm tcGblEnv = tmrTypechecked tcm details <- makeSimpleDetails hsc_env_tmp tcGblEnv @@ -255,7 +237,7 @@ mkHiFileResultCompile -> LinkableType -- ^ use object code or byte code? -> IO (IdeResult HiFileResult) mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do - let session = session' { hsc_dflags = ms_hspp_opts ms } + let session = hscSetFlags (ms_hspp_opts ms) session' ms = pm_mod_summary $ tmrParsed tcm tcGblEnv = tmrTypechecked tcm @@ -297,8 +279,8 @@ mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do initPlugins :: HscEnv -> ModSummary -> IO ModSummary initPlugins session modSummary = do - dflags <- liftIO $ initializePlugins session $ ms_hspp_opts modSummary - return modSummary{ms_hspp_opts = dflags} + session1 <- liftIO $ initializePlugins (hscSetFlags (ms_hspp_opts modSummary) session) + return modSummary{ms_hspp_opts = hsc_dflags session1} -- | Whether we should run the -O0 simplifier when generating core. -- @@ -318,9 +300,9 @@ compileModule (RunSimplifier simplify) session ms tcg = fmap (either (, Nothing) (second Just)) $ catchSrcErrors (hsc_dflags session) "compile" $ do (warnings,desugared_guts) <- withWarnings "compile" $ \tweak -> do - let ms' = tweak ms - session' = session{ hsc_dflags = ms_hspp_opts ms'} - desugar <- hscDesugar session' ms' tcg + let session' = tweak (hscSetFlags (ms_hspp_opts ms) session) + -- TODO: maybe settings ms_hspp_opts is unnecessary? + desugar <- hscDesugar session' (ms { ms_hspp_opts = hsc_dflags session' }) tcg if simplify then do plugins <- readIORef (tcg_th_coreplugins tcg) @@ -337,23 +319,20 @@ generateObjectCode session summary guts = do fp = replaceExtension dot_o "s" createDirectoryIfMissing True (takeDirectory fp) (warnings, dot_o_fp) <- - withWarnings "object" $ \_tweak -> do - let summary' = _tweak summary -#if MIN_VERSION_ghc(8,10,0) - target = defaultObjectTarget $ hsc_dflags session -#else - target = defaultObjectTarget $ targetPlatform $ hsc_dflags session -#endif - session' = session { hsc_dflags = updOptLevel 0 $ (ms_hspp_opts summary') { outputFile = Just dot_o , hscTarget = target}} + withWarnings "object" $ \tweak -> do + let env' = tweak (hscSetFlags (ms_hspp_opts summary) session) + target = platformDefaultBackend (hsc_dflags env') + newFlags = setBackend target $ updOptLevel 0 $ (hsc_dflags env') { outputFile = Just dot_o } + session' = hscSetFlags newFlags session #if MIN_VERSION_ghc(9,0,1) (outputFilename, _mStub, _foreign_files, _cinfos) <- hscGenHardCode session' guts #else (outputFilename, _mStub, _foreign_files) <- hscGenHardCode session' guts #endif #if MIN_VERSION_ghc(8,10,0) - (ms_location summary') + (ms_location summary) #else - summary' + summary #endif fp compileFile session' StopLn (outputFilename, Just (As False)) @@ -370,8 +349,9 @@ generateByteCode hscEnv summary guts = do catchSrcErrors (hsc_dflags hscEnv) "bytecode" $ do (warnings, (_, bytecode, sptEntries)) <- withWarnings "bytecode" $ \_tweak -> do - let summary' = _tweak summary - session = hscEnv { hsc_dflags = ms_hspp_opts summary' } + let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) + -- TODO: maybe settings ms_hspp_opts is unnecessary? + summary' = summary { ms_hspp_opts = hsc_dflags session } hscInteractive session guts #if MIN_VERSION_ghc(8,10,0) (ms_location summary') @@ -645,7 +625,7 @@ writeHiFile :: HscEnv -> HiFileResult -> IO [FileDiagnostic] writeHiFile hscEnv tc = handleGenerationErrors dflags "interface write" $ do atomicFileWrite targetPath $ \fp -> - writeIfaceFile dflags fp modIface + writeIfaceFile hscEnv fp modIface where modIface = hm_iface $ hirHomeMod tc targetPath = ml_hi_file $ ms_location $ hirModSummary tc @@ -674,7 +654,7 @@ setupFinderCache mss session = do -- Make modules available for others that import them, -- by putting them in the finder cache. - let ims = map (installedModule (thisInstalledUnitId $ hsc_dflags session) . moduleName . ms_mod) mss + let ims = map (installedModule (homeUnitId_ $ hsc_dflags session) . moduleName . ms_mod) mss ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) mss ims -- set the target and module graph in the session graph = mkModuleGraph mss @@ -718,7 +698,7 @@ getModSummaryFromImports :: HscEnv -> FilePath -> UTCTime - -> Maybe SB.StringBuffer + -> Maybe StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult getModSummaryFromImports env fp modTime contents = do (contents, opts, dflags) <- preprocessor env fp contents @@ -756,7 +736,7 @@ getModSummaryFromImports env fp modTime contents = do modLoc <- liftIO $ mkHomeModLocation dflags mod fp - let modl = mkModule (thisPackage dflags) mod + let modl = mkHomeModule (hscHomeUnit (hscSetFlags dflags env)) mod sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile msrModSummary = ModSummary @@ -800,7 +780,7 @@ parseHeader :: Monad m => DynFlags -- ^ flags to use -> FilePath -- ^ the filename (for source locations) - -> SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported) + -> StringBuffer -- ^ Haskell module source text (full Unicode is supported) #if MIN_VERSION_ghc(9,0,1) -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule)) #else @@ -808,7 +788,7 @@ parseHeader #endif parseHeader dflags filename contents = do let loc = mkRealSrcLoc (mkFastString filename) 1 1 - case unP Parser.parseHeader (mkPState dflags contents loc) of + case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of #if MIN_VERSION_ghc(8,10,0) PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags @@ -828,9 +808,9 @@ parseHeader dflags filename contents = do -- errors are those from which a parse tree just can't -- be produced. unless (null errs) $ - throwE $ diagFromErrMsgs "parser" dflags errs + throwE $ diagFromErrMsgs "parser" dflags (fmap pprError errs) - let warnings = diagFromErrMsgs "parser" dflags warns + let warnings = diagFromErrMsgs "parser" dflags (fmap pprWarning warns) return (warnings, rdr_module) -- | Given a buffer, flags, and file path, produce a @@ -846,7 +826,7 @@ parseFileContents env customPreprocessor filename ms = do let loc = mkRealSrcLoc (mkFastString filename) 1 1 dflags = ms_hspp_opts ms contents = fromJust $ ms_hspp_buf ms - case unP Parser.parseModule (mkPState dflags contents loc) of + case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of #if MIN_VERSION_ghc(8,10,0) PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags #else @@ -854,21 +834,8 @@ parseFileContents env customPreprocessor filename ms = do throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr #endif POk pst rdr_module -> - let hpm_annotations :: ApiAnns - hpm_annotations = -#if MIN_VERSION_ghc(9,0,1) - -- Copied from GHC.Driver.Main - ApiAnns { - apiAnnItems = Map.fromListWith (++) $ annotations pst, - apiAnnEofPos = eof_pos pst, - apiAnnComments = Map.fromList (annotations_comments pst), - apiAnnRogueComments = comment_q pst - } -#else - (Map.fromListWith (++) $ annotations pst, - Map.fromList ((noSrcSpan,comment_q pst) - :annotations_comments pst)) -#endif + let + hpm_annotations = mkApiAnns pst (warns, errs) = getMessages pst dflags in do @@ -919,13 +886,7 @@ parseFileContents env customPreprocessor filename ms = do -- filter them out: srcs2 <- liftIO $ filterM doesFileExist srcs1 - let pm = - ParsedModule { - pm_mod_summary = ms - , pm_parsed_source = parsed' - , pm_extra_src_files = srcs2 - , pm_annotations = hpm_annotations - } + let pm = mkParsedModule ms parsed' srcs2 hpm_annotations warnings = diagFromErrMsgs "parser" dflags warns pure (warnings ++ preproc_warnings, pm) @@ -944,7 +905,7 @@ loadInterface -> (Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult)) -- ^ Action to regenerate an interface -> m ([FileDiagnostic], Maybe HiFileResult) loadInterface session ms sourceMod linkableNeeded regen = do - let sessionWithMsDynFlags = session{hsc_dflags = ms_hspp_opts ms} + let sessionWithMsDynFlags = hscSetFlags (ms_hspp_opts ms) session res <- liftIO $ checkOldIface sessionWithMsDynFlags ms sourceMod Nothing case res of (UpToDate, Just iface) diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 544a88e7d7..4a113e19fe 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -8,13 +8,12 @@ module Development.IDE.Core.Preprocessor import Development.IDE.GHC.CPP import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () -import GhcMonad -import StringBuffer as SB import Control.DeepSeq (NFData (rnf)) import Control.Exception (evaluate) import Control.Exception.Safe (catch, throw) import Control.Monad.Trans.Except +import Control.Monad.IO.Class import Data.Char import Data.IORef (IORef, modifyIORef, newIORef, readIORef) @@ -26,24 +25,17 @@ import Development.IDE.GHC.Error import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import qualified GHC.LanguageExtensions as LangExt -import qualified HeaderInfo as Hdr -import HscTypes (HscEnv (hsc_dflags)) -import Outputable (showSDoc) -import SysTools (Option (..), runPp, - runUnlit) import System.FilePath import System.IO.Extra - -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. preprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> ExceptT [FileDiagnostic] IO (StringBuffer, [String], DynFlags) -preprocessor env filename mbContents = do +preprocessor env0 filename mbContents = do -- Perform unlit (isOnDisk, contents) <- if isLiterate filename then do - let dflags = hsc_dflags env - newcontent <- liftIO $ runLhs dflags filename mbContents + newcontent <- liftIO $ runLhs env0 filename mbContents return (False, newcontent) else do contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents @@ -51,14 +43,17 @@ preprocessor env filename mbContents = do return (isOnDisk, contents) -- Perform cpp - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents + (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env0 filename contents + let env1 = hscSetFlags dflags env0 + let logger = hsc_logger env1 (isOnDisk, contents, opts, dflags) <- if not $ xopt LangExt.Cpp dflags then return (isOnDisk, contents, opts, dflags) else do cppLogs <- liftIO $ newIORef [] + let newLogger = pushLogHook (const (logActionCompat $ logAction cppLogs)) logger contents <- ExceptT - $ (Right <$> (runCpp dflags {log_action = logActionCompat $ logAction cppLogs} filename + $ (Right <$> (runCpp (putLogHook newLogger env1) filename $ if isOnDisk then Nothing else Just contents)) `catch` ( \(e :: GhcException) -> do @@ -67,15 +62,15 @@ preprocessor env filename mbContents = do [] -> throw e diags -> return $ Left diags ) - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents + (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents return (False, contents, opts, dflags) -- Perform preprocessor if not $ gopt Opt_Pp dflags then return (contents, opts, dflags) else do - contents <- liftIO $ runPreprocessor dflags filename $ if isOnDisk then Nothing else Just contents - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env filename contents + contents <- liftIO $ runPreprocessor env1 filename $ if isOnDisk then Nothing else Just contents + (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents return (contents, opts, dflags) where logAction :: IORef [CPPLog] -> LogActionCompat @@ -107,7 +102,7 @@ diagsFromCPPLogs filename logs = -- informational log messages and attaches them to the initial log message. go :: [CPPDiag] -> [CPPLog] -> [CPPDiag] go acc [] = reverse $ map (\d -> d {cdMessage = reverse $ cdMessage d}) acc - go acc (CPPLog sev (OldRealSrcSpan span) msg : logs) = + go acc (CPPLog sev (RealSrcSpan span _) msg : logs) = let diag = CPPDiag (realSrcSpanToRange span) (toDSeverity sev) [msg] in go (diag : acc) logs go (diag : diags) (CPPLog _sev (UnhelpfulSpan _) msg : logs) = @@ -134,22 +129,22 @@ isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"] parsePragmasIntoDynFlags :: HscEnv -> FilePath - -> SB.StringBuffer + -> StringBuffer -> IO (Either [FileDiagnostic] ([String], DynFlags)) parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do - let opts = Hdr.getOptions dflags0 contents fp + let opts = getOptions dflags0 contents fp -- Force bits that might keep the dflags and stringBuffer alive unnecessarily evaluate $ rnf opts (dflags, _, _) <- parseDynamicFilePragma dflags0 opts - dflags' <- initializePlugins env dflags - return (map unLoc opts, disableWarningsAsErrors dflags') + hsc_env' <- initializePlugins (hscSetFlags dflags env) + return (map unLoc opts, disableWarningsAsErrors (hsc_dflags hsc_env')) where dflags0 = hsc_dflags env -- | Run (unlit) literate haskell preprocessor on a file, or buffer if set -runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer -runLhs dflags filename contents = withTempDir $ \dir -> do +runLhs :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer +runLhs env filename contents = withTempDir $ \dir -> do let fout = dir takeFileName filename <.> "unlit" filesrc <- case contents of Nothing -> return filename @@ -159,14 +154,17 @@ runLhs dflags filename contents = withTempDir $ \dir -> do hPutStringBuffer h cnts return fsrc unlit filesrc fout - SB.hGetStringBuffer fout + hGetStringBuffer fout where - unlit filein fileout = SysTools.runUnlit dflags (args filein fileout) + logger = hsc_logger env + dflags = hsc_dflags env + + unlit filein fileout = runUnlit logger dflags (args filein fileout) args filein fileout = [ - SysTools.Option "-h" - , SysTools.Option (escape filename) -- name this file - , SysTools.FileOption "" filein -- input file - , SysTools.FileOption "" fileout ] -- output file + Option "-h" + , Option (escape filename) -- name this file + , FileOption "" filein -- input file + , FileOption "" fileout ] -- output file -- taken from ghc's DriverPipeline.hs escape ('\\':cs) = '\\':'\\': escape cs escape ('\"':cs) = '\\':'\"': escape cs @@ -175,31 +173,32 @@ runLhs dflags filename contents = withTempDir $ \dir -> do escape [] = [] -- | Run CPP on a file -runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer -runCpp dflags filename contents = withTempDir $ \dir -> do +runCpp :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer +runCpp env0 filename contents = withTempDir $ \dir -> do let out = dir takeFileName filename <.> "out" - dflags <- pure $ addOptP "-D__GHCIDE__" dflags + dflags1 <- pure $ addOptP "-D__GHCIDE__" (hsc_dflags env0) + let env1 = hscSetFlags dflags1 env0 case contents of Nothing -> do -- Happy case, file is not modified, so run CPP on it in-place -- which also makes things like relative #include files work -- and means location information is correct - doCpp dflags True filename out - liftIO $ SB.hGetStringBuffer out + doCpp env1 True filename out + liftIO $ hGetStringBuffer out Just contents -> do -- Sad path, we have to create a version of the path in a temp dir -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue) -- Relative includes aren't going to work, so we fix that by adding to the include path. - dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags - + dflags2 <- return $ addIncludePathsQuote (takeDirectory filename) dflags1 + let env2 = hscSetFlags dflags2 env0 -- Location information is wrong, so we fix that by patching it afterwards. let inp = dir "___GHCIDE_MAGIC___" withBinaryFile inp WriteMode $ \h -> hPutStringBuffer h contents - doCpp dflags True inp out + doCpp env2 True inp out -- Fix up the filename in lines like: -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___" @@ -215,8 +214,8 @@ runCpp dflags filename contents = withTempDir $ \dir -> do -- | Run a preprocessor on a file -runPreprocessor :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer -runPreprocessor dflags filename contents = withTempDir $ \dir -> do +runPreprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer +runPreprocessor env filename contents = withTempDir $ \dir -> do let out = dir takeFileName filename <.> "out" inp <- case contents of Nothing -> return filename @@ -225,5 +224,8 @@ runPreprocessor dflags filename contents = withTempDir $ \dir -> do withBinaryFile inp WriteMode $ \h -> hPutStringBuffer h contents return inp - runPp dflags [SysTools.Option filename, SysTools.Option inp, SysTools.FileOption "" out] - SB.hGetStringBuffer out + runPp logger dflags [Option filename, Option inp, FileOption "" out] + hGetStringBuffer out + where + logger = hsc_logger env + dflags = hsc_dflags env diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 0b19fc85a4..1f73f200d8 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -32,11 +32,6 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq) import Development.IDE.Types.KnownTargets import GHC.Generics (Generic) -import HscTypes (HomeModInfo, - ModGuts, - hm_iface, - hm_linkable) - import qualified Data.Binary as B import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS @@ -46,10 +41,8 @@ import Development.IDE.Import.FindImports (ArtifactsLocation import Development.IDE.Spans.Common import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Diagnostics -import Fingerprint import GHC.Serialized (Serialized) import Language.LSP.Types (NormalizedFilePath) -import TcRnMonad (TcGblEnv) data LinkableType = ObjectLinkable | BCOLinkable deriving (Eq,Ord,Show, Generic) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 0d4c082931..06b4a9e5db 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -103,12 +103,13 @@ import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat hiding - (TargetFile, - TargetModule, - parseModule, - typecheckModule, - writeHieFile) +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Core hiding + (parseModule, + TargetId(..), + loadInterface, + Var) +import qualified Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util hiding @@ -125,21 +126,15 @@ import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Location import qualified Development.IDE.Types.Logger as L import Development.IDE.Types.Options -import Fingerprint import GHC.Generics (Generic) import GHC.IO.Encoding import qualified GHC.LanguageExtensions as LangExt import qualified HieDb -import HscTypes hiding - (TargetFile, - TargetModule) import Ide.Plugin.Config import qualified Language.LSP.Server as LSP import Language.LSP.Types (SMethod (SCustomMethod)) import Language.LSP.VFS -import Module import System.Directory (canonicalizePath, makeAbsolute) -import TcRnMonad (tcg_dependent_files) import Control.Applicative import Data.Default (def) @@ -343,7 +338,7 @@ getLocatedImportsRule = | otherwise = return Nothing (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do - diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource + diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource case diagOrImp of Left diags -> pure (diags, Just (modName, Nothing)) Right (FileImport path) -> pure ([], Just (modName, Just path)) @@ -523,9 +518,9 @@ persistentHieFileRule = addPersistentRule GetHieAst $ \file -> runMaybeT $ do case mvf of Nothing -> (,Nothing) . T.decode encoding <$> BS.readFile (fromNormalizedFilePath file) Just vf -> pure (Rope.toText $ _text vf, Just $ _lsp_version vf) - let refmap = generateReferencesMap . getAsts . hie_asts $ res - del = deltaFromDiff (T.decode encoding $ hie_hs_src res) currentSource - pure (HAR (hie_module res) (hie_asts res) refmap mempty (HieFromDisk res),del,ver) + let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res + del = deltaFromDiff (T.decode encoding $ Compat.hie_hs_src res) currentSource + pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver) getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult) getHieAstRuleDefinition f hsc tmr = do @@ -546,8 +541,8 @@ getHieAstRuleDefinition f hsc tmr = do liftIO $ writeAndIndexHieFile hsc se msum f exports asts source _ -> pure [] - let refmap = generateReferencesMap . getAsts <$> masts - typemap = AtPoint.computeTypeReferences . getAsts <$> masts + let refmap = Compat.generateReferencesMap . Compat.getAsts <$> masts + typemap = AtPoint.computeTypeReferences . Compat.getAsts <$> masts pure (diags <> diagsWrite, HAR (ms_mod $ tmrModSummary tmr) <$> masts <*> refmap <*> typemap <*> pure HieFresh) getImportMapRule :: Rules () @@ -584,7 +579,7 @@ getDocMapRule = persistentDocMapRule :: Rules () persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing) -readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction HieFile +readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction Compat.HieFile readHieFileForSrcFromDisk file = do db <- asks hiedb log <- asks $ L.logDebug . logger @@ -593,7 +588,7 @@ readHieFileForSrcFromDisk file = do liftIO $ log $ "LOADING HIE FILE :" <> T.pack (show file) exceptToMaybeT $ readHieFileFromDisk hie_loc -readHieFileFromDisk :: FilePath -> ExceptT SomeException IdeAction HieFile +readHieFileFromDisk :: FilePath -> ExceptT SomeException IdeAction Compat.HieFile readHieFileFromDisk hie_loc = do nc <- asks ideNc log <- asks $ L.logDebug . logger @@ -754,7 +749,7 @@ getModIfaceFromDiskAndIndexRule = -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db let ms = hirModSummary x - hie_loc = ml_hie_file $ ms_location ms + hie_loc = Compat.ml_hie_file $ ms_location ms hash <- liftIO $ getFileHash hie_loc mrow <- liftIO $ HieDb.lookupHieFileFromSource hiedb (fromNormalizedFilePath f) hie_loc' <- liftIO $ traverse (canonicalizePath . HieDb.hieModuleHieFile) mrow @@ -785,7 +780,7 @@ isHiFileStableRule :: Rules () isHiFileStableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsHiFileStable f -> do ms <- msrModSummary <$> use_ GetModSummaryWithoutTimestamps f let hiFile = toNormalizedFilePath' - $ ml_hi_file $ ms_location ms + $ Compat.ml_hi_file $ ms_location ms mbHiVersion <- use GetModificationTime_{missingFileDiagnostics=False} hiFile modVersion <- use_ GetModificationTime f sourceModified <- case mbHiVersion of @@ -811,7 +806,7 @@ getModSummaryRule = do defineEarlyCutoff $ Rule $ \GetModSummary f -> do session' <- hscEnv <$> use_ GhcSession f modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal - let session = session' { hsc_dflags = modify_dflags $ hsc_dflags session' } + let session = hscSetFlags (modify_dflags $ hsc_dflags session') session' (modTime, mFileContent) <- getFileContents f let fp = fromNormalizedFilePath f modS <- liftIO $ runExceptT $ @@ -1047,7 +1042,7 @@ instance IsIdeGlobal CompiledLinkables writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic] writeHiFileAction hsc hiFile = do extras <- getShakeExtras - let targetPath = ml_hi_file $ ms_location $ hirModSummary hiFile + let targetPath = Compat.ml_hi_file $ ms_location $ hirModSummary hiFile liftIO $ do resetInterfaceStore extras $ toNormalizedFilePath' targetPath writeHiFile hsc hiFile diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 37bfa9dc6a..d90cf01009 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -109,7 +109,11 @@ import Development.IDE.Core.PositionMapping import Development.IDE.Core.ProgressReporting import Development.IDE.Core.RuleTypes import Development.IDE.Core.Tracing -import Development.IDE.GHC.Compat (NameCacheUpdater (..), upNameCache) +import Development.IDE.GHC.Compat (NameCacheUpdater (..), + upNameCache, NameCache, + initNameCache, + mkSplitUniqSupply, + knownKeyNames) import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import qualified Development.IDE.Graph as Shake @@ -137,10 +141,7 @@ import System.Time.Extra import Data.IORef import GHC.Fingerprint import Language.LSP.Types.Capabilities -import NameCache import OpenTelemetry.Eventlog -import PrelInfo -import UniqSupply import Control.Exception.Extra hiding (bracket_) import qualified Data.ByteString.Char8 as BS8 diff --git a/ghcide/src/Development/IDE/Core/UseStale.hs b/ghcide/src/Development/IDE/Core/UseStale.hs index df19b47a95..c27fd0fd6f 100644 --- a/ghcide/src/Development/IDE/Core/UseStale.hs +++ b/ghcide/src/Development/IDE/Core/UseStale.hs @@ -29,6 +29,10 @@ import Data.Functor ((<&>)) import Data.Functor.Identity (Identity (Identity)) import Data.Kind (Type) import Data.String (fromString) +import Development.IDE.GHC.Compat (RealSrcSpan, + srcSpanFile, + + unpackFS) import Development.IDE (Action, IdeRule, NormalizedFilePath, Range, @@ -36,8 +40,6 @@ import Development.IDE (Action, IdeRule, realSrcSpanToRange) import qualified Development.IDE.Core.PositionMapping as P import qualified Development.IDE.Core.Shake as IDE -import qualified FastString as FS -import SrcLoc ------------------------------------------------------------------------------ @@ -113,7 +115,7 @@ instance MapAge Range where instance MapAge RealSrcSpan where mapAgeFrom = - invMapAge (\fs -> rangeToRealSrcSpan (fromString $ FS.unpackFS fs)) + invMapAge (\fs -> rangeToRealSrcSpan (fromString $ unpackFS fs)) (srcSpanFile &&& realSrcSpanToRange) . mapAgeFrom diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 287ce61ac4..9248cbfe29 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -24,148 +24,25 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where +import GHC import Development.IDE.GHC.Compat as Compat -import FileCleanup -import Packages -import Panic -import SysTools -#if MIN_VERSION_ghc(8,8,2) -import LlvmCodeGen (llvmVersionList) -#elif MIN_VERSION_ghc(8,8,0) -import LlvmCodeGen (LlvmVersion (..)) +#if !MIN_VERSION_ghc(8,10,0) +import qualified Development.IDE.GHC.Compat.CPP as CPP #endif + +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Driver.Pipeline as Pipeline +import GHC.SysTools as SysTools +import GHC.Settings +import GHC.Utils.Fingerprint +#else #if MIN_VERSION_ghc (8,10,0) -import Fingerprint +import qualified DriverPipeline as Pipeline import ToolSettings -#endif - -import Control.Monad -import Data.List (intercalate) -import Data.Maybe -import Data.Version -import System.Directory -import System.FilePath -import System.Info - - - -doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO () -doCpp dflags raw input_fn output_fn = do - let hscpp_opts = picPOpts dflags - let cmdline_include_paths = includePaths dflags - - pkg_include_dirs <- getPackageIncludePath dflags [] - let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) [] - (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs) - let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) [] - (includePathsQuote cmdline_include_paths) - let include_paths = include_paths_quote ++ include_paths_global - - let verbFlags = getVerbFlags dflags - - let cpp_prog args | raw = SysTools.runCpp dflags args -#if MIN_VERSION_ghc(8,10,0) - | otherwise = SysTools.runCc Nothing #else - | otherwise = SysTools.runCc +import DynFlags #endif - dflags (SysTools.Option "-E" : args) - - let target_defs = - -- NEIL: Patched to use System.Info instead of constants from CPP - [ "-D" ++ os ++ "_BUILD_OS", - "-D" ++ arch ++ "_BUILD_ARCH", - "-D" ++ os ++ "_HOST_OS", - "-D" ++ arch ++ "_HOST_ARCH" ] - -- remember, in code we *compile*, the HOST is the same our TARGET, - -- and BUILD is the same as our HOST. - - let sse_defs = - [ "-D__SSE__" | isSseEnabled dflags ] ++ - [ "-D__SSE2__" | isSse2Enabled dflags ] ++ - [ "-D__SSE4_2__" | isSse4_2Enabled dflags ] - - let avx_defs = - [ "-D__AVX__" | isAvxEnabled dflags ] ++ - [ "-D__AVX2__" | isAvx2Enabled dflags ] ++ - [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++ - [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++ - [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++ - [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ] - - backend_defs <- getBackendDefs dflags - - let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ] - -- Default CPP defines in Haskell source - ghcVersionH <- getGhcVersionPathName dflags - let hsSourceCppOpts = [ "-include", ghcVersionH ] - - -- MIN_VERSION macros - let uids = explicitPackages (pkgState dflags) - pkgs = catMaybes (map (lookupPackage dflags) uids) - mb_macro_include <- - if not (null pkgs) && gopt Opt_VersionMacros dflags - then do macro_stub <- newTempName dflags TFL_CurrentModule "h" - writeFile macro_stub (generatePackageVersionMacros pkgs) - -- Include version macros for every *exposed* package. - -- Without -hide-all-packages and with a package database - -- size of 1000 packages, it takes cpp an estimated 2 - -- milliseconds to process this file. See #10970 - -- comment 8. - return [SysTools.FileOption "-include" macro_stub] - else return [] - - cpp_prog ( map SysTools.Option verbFlags - ++ map SysTools.Option include_paths - ++ map SysTools.Option hsSourceCppOpts - ++ map SysTools.Option target_defs - ++ map SysTools.Option backend_defs - ++ map SysTools.Option th_defs - ++ map SysTools.Option hscpp_opts - ++ map SysTools.Option sse_defs - ++ map SysTools.Option avx_defs - ++ mb_macro_include - -- Set the language mode to assembler-with-cpp when preprocessing. This - -- alleviates some of the C99 macro rules relating to whitespace and the hash - -- operator, which we tend to abuse. Clang in particular is not very happy - -- about this. - ++ [ SysTools.Option "-x" - , SysTools.Option "assembler-with-cpp" - , SysTools.Option input_fn - -- We hackily use Option instead of FileOption here, so that the file - -- name is not back-slashed on Windows. cpp is capable of - -- dealing with / in filenames, so it works fine. Furthermore - -- if we put in backslashes, cpp outputs #line directives - -- with *double* backslashes. And that in turn means that - -- our error messages get double backslashes in them. - -- In due course we should arrange that the lexer deals - -- with these \\ escapes properly. - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn - ]) - -getBackendDefs :: DynFlags -> IO [String] -getBackendDefs dflags | hscTarget dflags == HscLlvm = do - llvmVer <- figureLlvmVersion dflags - return $ case llvmVer of -#if MIN_VERSION_ghc(8,8,2) - Just v - | [m] <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, 0) ] - | m:n:_ <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, n) ] -#elif MIN_VERSION_ghc(8,8,0) - Just (LlvmVersion n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (n,0) ] - Just (LlvmVersionOld m n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ] -#else - Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ] #endif - _ -> [] - where - format (major, minor) - | minor >= 100 = error "getBackendDefs: Unsupported minor version" - | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int - -getBackendDefs _ = - return [] addOptP :: String -> DynFlags -> DynFlags #if MIN_VERSION_ghc (8,10,0) @@ -183,47 +60,13 @@ addOptP opt = onSettings (onOptP (opt:)) onOptP f x = x{sOpt_P = f $ sOpt_P x} #endif --- --------------------------------------------------------------------------- --- Macros (cribbed from Cabal) - -generatePackageVersionMacros :: [Compat.PackageConfig] -> String -generatePackageVersionMacros pkgs = concat - -- Do not add any C-style comments. See #3389. - [ generateMacros "" pkgname version - | pkg <- pkgs - , let version = packageVersion pkg - pkgname = map fixchar (packageNameString pkg) - ] - -fixchar :: Char -> Char -fixchar '-' = '_' -fixchar c = c - -generateMacros :: String -> String -> Version -> String -generateMacros prefix name version = - concat - ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n" - ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n" - ," (major1) < ",major1," || \\\n" - ," (major1) == ",major1," && (major2) < ",major2," || \\\n" - ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" - ,"\n\n" - ] - where - (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) - - --- | Find out path to @ghcversion.h@ file -getGhcVersionPathName :: DynFlags -> IO FilePath -getGhcVersionPathName dflags = do - candidates <- case ghcVersionFile dflags of - Just path -> return [path] - Nothing -> (map ( "ghcversion.h")) <$> - (getPackageIncludePath dflags [Compat.toInstalledUnitId Compat.rtsUnit]) +doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO () +doCpp env raw input_fn output_fn = +#if MIN_VERSION_ghc (9,2,0) + Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) raw input_fn output_fn +#elif MIN_VERSION_ghc (8,10,0) + Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn +#else + CPP.doCpp (hsc_dflags env) raw input_fn output_fn +#endif - found <- filterM doesFileExist candidates - case found of - [] -> throwGhcExceptionIO (InstallationError - ("ghcversion.h missing; tried: " - ++ intercalate ", " candidates)) - (x:_) -> return x diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index d5e8dd9e29..96b7390f58 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -5,212 +5,201 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} -{-# OPTIONS -Wno-dodgy-imports -Wno-incomplete-uni-patterns #-} -{-# OPTIONS -Wno-missing-signatures #-} -- TODO: Remove! +{-# OPTIONS -Wno-incomplete-uni-patterns #-} -- | Attempt at hiding the GHC version differences we can. module Development.IDE.GHC.Compat( - HieFileResult(..), - HieFile(..), NameCacheUpdater(..), - hieExportNames, - mkHieFile', - enrichHie, - writeHieFile, - readHieFile, - supportsHieFiles, - setHieDir, - dontWriteHieFiles, -#if !MIN_VERSION_ghc(8,8,0) - ml_hie_file, - addBootSuffixLocnOut, - getRealSrcSpan, -#endif hPutStringBuffer, addIncludePathsQuote, getModuleHash, - getPackageName, setUpTypedHoles, GHC.ModLocation, Module.addBootSuffix, pattern ModLocation, - pattern ExposePackage, - HasSrcSpan, - getLoc, + ml_hs_file, + ml_obj_file, + ml_hi_file, + ml_hie_file, upNameCache, disableWarningsAsErrors, - AvailInfo, - tcg_exports, - pattern FunTy, #if MIN_VERSION_ghc(8,10,0) module GHC.Hs.Extension, - module LinkerTypes, #else module HsExtension, noExtField, - linkableTime, #endif -#if MIN_VERSION_ghc(9,0,1) - -- Reexports from GHC - UnitId, - moduleUnitId, - pkgState, - thisInstalledUnitId, - -- Reexports from DynFlags - thisPackage, - writeIfaceFile, - - gcatch, -#else +#if !MIN_VERSION_ghc(9,0,1) RefMap, - Unit, #endif -- Linear Scaled, scaledThing, - lookupUnit', - preloadClosureUs, - -- Reexports from Package - InstalledUnitId, - PackageConfig, - getPackageConfigMap, - getPackageIncludePath, - installedModule, - - pattern DefiniteUnitId, - packageName, - packageNameString, - packageVersion, - toInstalledUnitId, - lookupPackage, - -- lookupPackage', - explicitPackages, - exposedModules, - packageConfigId, - setThisInstalledUnitId, - initUnits, - lookupInstalledPackage, - oldLookupInstalledPackage, - unitDepends, - - haddockInterfaces, - - oldUnhelpfulSpan , +#if MIN_VERSION_ghc(9,0,0) + IsBootInterface(..), +#else pattern IsBoot, pattern NotBoot, - pattern OldRealSrcSpan, - - oldRenderWithStyle, - oldMkUserStyle, - oldMkErrStyle, - oldFormatErrDoc, - oldListVisibleModuleNames, - oldLookupModuleWithSuggestions, +#endif nodeInfo', getNodeIds, stringToUnit, - rtsUnit, unitString, - LogActionCompat, - logActionCompat, - pprSigmaType, - module GHC, - module DynFlags, - initializePlugins, - applyPluginsParsedResultAction, - module Compat.HieTypes, - module Compat.HieUtils, - dropForAll, isQualifiedImport, GhcVersion(..), ghcVersion, - ghcVersionStr + ghcVersionStr, + -- * HIE Compat + HieFileResult(..), + HieFile(..), + hieExportNames, + mkHieFile', + enrichHie, + writeHieFile, + readHieFile, + supportsHieFiles, + setHieDir, + dontWriteHieFiles, + module Compat.HieTypes, + module Compat.HieUtils, + -- * Compat modules + module Development.IDE.GHC.Compat.Core, + module Development.IDE.GHC.Compat.Env, + module Development.IDE.GHC.Compat.Iface, + module Development.IDE.GHC.Compat.Logger, + module Development.IDE.GHC.Compat.Outputable, + module Development.IDE.GHC.Compat.Parser, + module Development.IDE.GHC.Compat.Plugins, + module Development.IDE.GHC.Compat.Units, + -- * Extras that rely on compat modules + -- * SysTools + Option (..), + runUnlit, + runPp, ) where -#if MIN_VERSION_ghc(8,10,0) -import LinkerTypes -#endif +import GHC hiding (HasSrcSpan, ModLocation, getLoc, + lookupName, RealSrcSpan) +import qualified GHC + +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Iface +import Development.IDE.GHC.Compat.Logger +import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Parser +import Development.IDE.GHC.Compat.Plugins +import Development.IDE.GHC.Compat.Units +#if MIN_VERSION_ghc(9,0,0) +import GHC.Core.DataCon (dataConWrapId) +import GHC.Core.ConLike (ConLike(..)) +import GHC.Core.Multiplicity +import qualified GHC.Core.TyCo.Rep as TyCoRep +import GHC.Data.StringBuffer +import GHC.Data.FastString +import GHC.Data.Bag +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags +#if !MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Types +#endif +import GHC.Hs.Extension +import qualified GHC.Hs.Type as GHC +import GHC.Iface.Load +import GHC.Iface.Make (mkIfaceExports) +import GHC.Unit.Info (PackageName) +import qualified GHC.Unit.Info as Packages +import qualified GHC.Unit.Module.Location as Module +import GHC.Unit.Module.Name (moduleNameSlashes) +import GHC.Unit.State (ModuleOrigin(..)) +import qualified GHC.Unit.State as Packages +import qualified GHC.Unit.Types as Module +import GHC.Unit.Types (unitString, IsBootInterface(..)) +import GHC.Utils.Fingerprint +import GHC.Utils.Panic +import qualified GHC.SysTools.Tasks as SysTools +import GHC.Tc.Types (TcGblEnv(..)) +import GHC.Tc.Utils.TcType (pprSigmaType) +import qualified GHC.Types.Avail as Avail +import GHC.Types.FieldLabel +import GHC.Types.Name +import GHC.Types.Name.Occurrence +import GHC.Types.Name.Cache +import GHC.Types.Name.Env +import GHC.Types.Name.Reader (rdrNameOcc) +import GHC.Types.SrcLoc (BufSpan) +import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.Var +import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) +#else import DynFlags hiding (ExposePackage) -import qualified DynFlags -import qualified ErrUtils as Err -import Fingerprint (Fingerprint) import qualified Module -import qualified Outputable as Out -import StringBuffer -#if MIN_VERSION_ghc(9,0,1) +#if MIN_VERSION_ghc(9,0,0) import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) -import qualified Data.Set as S import GHC.Core.TyCo.Ppr (pprSigmaType) import GHC.Core.TyCo.Rep (Scaled, scaledThing) import GHC.Iface.Load import GHC.Types.Unique.Set (emptyUniqSet) import Module (unitString) -import qualified SrcLoc #else -import Module (InstalledUnitId, - UnitId (DefiniteUnitId), - toInstalledUnitId) import TcType (pprSigmaType) #endif -import Compat.HieAst (enrichHie) -import Compat.HieBin -import Compat.HieTypes -import Compat.HieUtils -import qualified Data.ByteString as BS -import Data.IORef -import HscTypes -import MkIface -import NameCache -import Packages -import TcRnTypes +import HscTypes +import MkIface hiding (writeIfaceFile) #if MIN_VERSION_ghc(8,10,0) import GHC.Hs.Extension #else import HsExtension #endif +import qualified Avail -import Avail -import GHC hiding (HasSrcSpan, ModLocation, getLoc, - lookupName) -import qualified GHC -import qualified TyCoRep #if MIN_VERSION_ghc(8,8,0) -import Data.List (foldl') -#else -import Data.List (foldl', isSuffixOf) +import StringBuffer (hPutStringBuffer) #endif - -import qualified Data.Map as M -import DynamicLoading -import Plugins (Plugin (parsedResultAction), - withPlugins) +import qualified SysTools #if !MIN_VERSION_ghc(8,8,0) import SrcLoc (RealLocated) import System.FilePath ((-<.>)) -#endif - -#if !MIN_VERSION_ghc(8,8,0) import qualified EnumSet import Foreign.ForeignPtr import System.IO +#endif +#endif +import Compat.HieAst (enrichHie) +import Compat.HieBin +import Compat.HieTypes +import Compat.HieUtils +import qualified Data.ByteString as BS +import Data.IORef +import qualified Data.Map as Map + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import qualified Data.Set as S +#endif +#if MIN_VERSION_ghc(8,8,0) +import Data.List (foldl') +#else +import Data.List (foldl', isSuffixOf) +#endif + +#if !MIN_VERSION_ghc(8,8,0) hPutStringBuffer :: Handle -> StringBuffer -> IO () hPutStringBuffer hdl (StringBuffer buf len cur) = withForeignPtr (plusForeignPtr buf cur) $ \ptr -> hPutBuf hdl ptr len - #endif #if !MIN_VERSION_ghc(8,10,0) @@ -232,20 +221,20 @@ ml_hie_file ml #endif upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c -#if !MIN_VERSION_ghc(8,8,0) +#if MIN_VERSION_ghc(8,8,0) +upNameCache = updNameCache +#else upNameCache ref upd_fn = atomicModifyIORef' ref upd_fn -#else -upNameCache = updNameCache #endif #if !MIN_VERSION_ghc(9,0,1) -type RefMap a = M.Map Identifier [(Span, IdentifierDetails a)] +type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)] #endif mkHieFile' :: ModSummary - -> [AvailInfo] + -> [Avail.AvailInfo] -> HieASTs Type -> BS.ByteString -> Hsc HieFile @@ -312,45 +301,10 @@ setUpTypedHoles df } -nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)] +nameListFromAvails :: [Avail.AvailInfo] -> [(SrcSpan, Name)] nameListFromAvails as = - map (\n -> (nameSrcSpan n, n)) (concatMap availNames as) - -#if MIN_VERSION_ghc(9,0,0) --- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x) --- type HasSrcSpan x = () :: Constraint - -class HasSrcSpan a where - getLoc :: a -> SrcSpan + map (\n -> (nameSrcSpan n, n)) (concatMap Avail.availNames as) -instance HasSrcSpan (GenLocated SrcSpan a) where - getLoc = GHC.getLoc - --- getLoc :: GenLocated l a -> l --- getLoc = GHC.getLoc - -#elif MIN_VERSION_ghc(8,8,0) -type HasSrcSpan = GHC.HasSrcSpan -getLoc :: HasSrcSpan a => a -> SrcSpan -getLoc = GHC.getLoc - -#else - -class HasSrcSpan a where - getLoc :: a -> SrcSpan -instance HasSrcSpan Name where - getLoc = nameSrcSpan -instance HasSrcSpan (GenLocated SrcSpan a) where - getLoc = GHC.getLoc - --- | Add the @-boot@ suffix to all output file paths associated with the --- module, not including the input file itself -addBootSuffixLocnOut :: GHC.ModLocation -> GHC.ModLocation -addBootSuffixLocnOut locn - = locn { ml_hi_file = Module.addBootSuffix (ml_hi_file locn) - , ml_obj_file = Module.addBootSuffix (ml_obj_file locn) - } -#endif getModuleHash :: ModIface -> Fingerprint #if MIN_VERSION_ghc(8,10,0) @@ -359,128 +313,29 @@ getModuleHash = mi_mod_hash . mi_final_exts getModuleHash = mi_mod_hash #endif --- type PackageName = Packages.PackageName -#if MIN_VERSION_ghc(9,0,0) --- NOTE: Since both the new and old version uses UnitId with different meaning, --- we try to avoid it and instead use InstalledUnitId and Unit, since it is unambiguous. -type UnitId = Module.Unit -type InstalledUnitId = Module.UnitId -type PackageConfig = Packages.UnitInfo -pattern DefiniteUnitId x = Module.RealUnit x -definiteUnitId = Module.RealUnit -defUnitId = Module.Definite -installedModule = Module.Module --- pattern InstalledModule a b = Module.Module a b +#if MIN_VERSION_ghc(9,2,0) + +packageName = Packages.unitPackageName +moduleUnitId = Module.moduleUnit +thisInstalledUnitId = GHC.homeUnitId_ +thisPackage = GHC.homeUnitId_ + +#elif MIN_VERSION_ghc(9,0,0) packageName = Packages.unitPackageName -lookupPackage = Packages.lookupUnit . unitState --- lookupPackage' = undefined --- lookupPackage' b pm u = Packages.lookupUnit' b pm undefined u --- lookupPackage' b pm u = Packages.lookupUnit' b pm emptyUniqSet u -- TODO: Is this correct? --- lookupPackage' = fmap Packages.lookupUnit' . unitState -getPackageConfigMap = Packages.unitInfoMap . unitState -preloadClosureUs = Packages.preloadClosure . unitState --- getPackageConfigMap = unitState --- getPackageIncludePath = undefined getPackageIncludePath = Packages.getUnitIncludePath -explicitPackages = Packages.explicitUnits -pkgState = GHC.unitState -packageNameString = Packages.unitPackageNameString -packageVersion = Packages.unitPackageVersion --- toInstalledUnitId = id -- Module.toUnitId -- TODO: This is probably wrong -toInstalledUnitId = Module.toUnitId -exposedModules = Packages.unitExposedModules -packageConfigId = Packages.mkUnit moduleUnitId = Module.moduleUnit -lookupInstalledPackage = Packages.lookupUnitId -oldLookupInstalledPackage = Packages.lookupUnitId . unitState -- initUnits = Packages.initUnits -- initPackages = initPackagesx -haddockInterfaces = unitHaddockInterfaces thisInstalledUnitId = GHC.homeUnitId thisPackage = DynFlags.homeUnit -setThisInstalledUnitId uid df = df { homeUnitId = uid} - -oldUnhelpfulSpan = UnhelpfulSpan . SrcLoc.UnhelpfulOther --- unhelpfulOther = unhelpfulOther . _ -pattern OldRealSrcSpan :: RealSrcSpan -> SrcSpan -pattern OldRealSrcSpan x <- RealSrcSpan x _ where - OldRealSrcSpan x = RealSrcSpan x Nothing -{-# COMPLETE OldRealSrcSpan, UnhelpfulSpan #-} - -oldListVisibleModuleNames = Packages.listVisibleModuleNames . unitState -oldLookupModuleWithSuggestions = Packages.lookupModuleWithSuggestions . unitState --- oldLookupInPackageDB = Packages.lookupInPackageDB . unitState - -oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc -oldMkUserStyle _ = Out.mkUserStyle -oldMkErrStyle _ = Out.mkErrStyle - --- TODO: This is still a mess! -oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc -oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext - where dummySDocContext = initSDocContext dflags Out.defaultUserStyle --- oldFormatErrDoc = Err.formatErrDoc . undefined -writeIfaceFile = writeIface - -type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> Out.SDoc -> IO () - --- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. -logActionCompat :: LogActionCompat -> LogAction -logActionCompat logAction dynFlags wr severity loc = logAction dynFlags wr severity loc alwaysQualify - --- We are using Safe here, which is not equivalent, but probably what we want. -gcatch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a -gcatch = Safe.catch - #else -type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> Out.SDoc -> IO () - -logActionCompat :: LogActionCompat -> LogAction -logActionCompat logAction dynFlags wr severity loc style = logAction dynFlags wr severity loc (Out.queryQual style) - -type Unit = Module.UnitId --- type PackageConfig = Packages.PackageConfig -definiteUnitId :: Module.DefUnitId -> UnitId -definiteUnitId = Module.DefiniteUnitId -defUnitId :: InstalledUnitId -> Module.DefUnitId -defUnitId = Module.DefUnitId -installedModule :: InstalledUnitId -> ModuleName -> Module.InstalledModule -installedModule = Module.InstalledModule -oldLookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig -oldLookupInstalledPackage = Packages.lookupInstalledPackage --- packageName = Packages.packageName --- lookupPackage = Packages.lookupPackage --- getPackageConfigMap = Packages.getPackageConfigMap -setThisInstalledUnitId :: InstalledUnitId -> DynFlags -> DynFlags -setThisInstalledUnitId uid df = df { thisInstalledUnitId = uid} - -lookupUnit' :: Bool -> PackageConfigMap -> p -> UnitId -> Maybe PackageConfig -lookupUnit' b pcm _ = Packages.lookupPackage' b pcm -preloadClosureUs = const () - -oldUnhelpfulSpan = UnhelpfulSpan -pattern OldRealSrcSpan :: RealSrcSpan -> SrcSpan -pattern OldRealSrcSpan x = RealSrcSpan x -{-# COMPLETE OldRealSrcSpan, UnhelpfulSpan #-} pattern NotBoot, IsBoot :: IsBootInterface pattern NotBoot = False pattern IsBoot = True -initUnits = fmap fst . Packages.initPackages - -unitDepends = depends - -oldListVisibleModuleNames = Packages.listVisibleModuleNames -oldLookupModuleWithSuggestions = Packages.lookupModuleWithSuggestions --- oldLookupInPackageDB = Packages.lookupInPackageDB - -oldRenderWithStyle = Out.renderWithStyle -oldMkUserStyle = Out.mkUserStyle -oldMkErrStyle = Out.mkErrStyle -oldFormatErrDoc = Err.formatErrDoc -- Linear Haskell type Scaled a = a @@ -488,8 +343,6 @@ scaledThing :: Scaled a -> a scaledThing = id #endif -getPackageName :: DynFlags -> InstalledUnitId -> Maybe PackageName -getPackageName dfs i = packageName <$> lookupPackage dfs (definiteUnitId (defUnitId i)) disableWarningsAsErrors :: DynFlags -> DynFlags disableWarningsAsErrors df = @@ -499,40 +352,6 @@ disableWarningsAsErrors df = wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags wopt_unset_fatal dfs f = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } - -getRealSrcSpan :: RealLocated a -> RealSrcSpan -getRealSrcSpan = GHC.getLoc -#endif - -applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> ApiAnns -> ParsedSource -> IO ParsedSource -applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do - -- Apply parsedResultAction of plugins - let applyPluginAction p opts = parsedResultAction p opts ms - fmap hpm_module $ - runHsc env $ withPlugins dflags applyPluginAction - (HsParsedModule parsed [] hpm_annotations) - -pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag --- https://github.com/facebook/fbghc -#ifdef __FACEBOOK_HASKELL__ -pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr -#else -pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr -#endif - --- | Take AST representation of type signature and drop `forall` part from it (if any), returning just type's body -dropForAll :: LHsType pass -> LHsType pass -#if MIN_VERSION_ghc(8,10,0) -dropForAll = snd . GHC.splitLHsForAllTyInvis -#else -dropForAll = snd . GHC.splitLHsForAllTy -#endif - -pattern FunTy :: Type -> Type -> Type -#if MIN_VERSION_ghc(8,10,0) -pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res} -#else -pattern FunTy arg res <- TyCoRep.FunTy arg res #endif isQualifiedImport :: ImportDecl a -> Bool @@ -547,19 +366,19 @@ isQualifiedImport _ = False #if MIN_VERSION_ghc(9,0,0) -getNodeIds :: HieAST a -> M.Map Identifier (IdentifierDetails a) -getNodeIds = M.foldl' combineNodeIds M.empty . getSourcedNodeInfo . sourcedNodeInfo +getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a) +getNodeIds = Map.foldl' combineNodeIds Map.empty . getSourcedNodeInfo . sourcedNodeInfo -ad `combineNodeIds` (NodeInfo _ _ bd) = M.unionWith (<>) ad bd +ad `combineNodeIds` (NodeInfo _ _ bd) = Map.unionWith (<>) ad bd -- Copied from GHC and adjusted to accept TypeIndex instead of Type -- nodeInfo' :: Ord a => HieAST a -> NodeInfo a nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex -nodeInfo' = M.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo +nodeInfo' = Map.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a (NodeInfo as ai ad) `combineNodeInfo'` (NodeInfo bs bi bd) = - NodeInfo (S.union as bs) (mergeSorted ai bi) (M.unionWith (<>) ad bd) + NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd) where mergeSorted :: Ord a => [a] -> [a] -> [a] mergeSorted la@(a:as) lb@(b:bs) = case compare a b of @@ -570,9 +389,9 @@ combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a mergeSorted [] bs = bs stringToUnit = Module.stringToUnit -rtsUnit = Module.rtsUnit #else +getNodeIds :: HieAST a -> NodeIdentifiers a getNodeIds = nodeIdentifiers . nodeInfo -- import qualified FastString as FS @@ -588,7 +407,6 @@ stringToUnit = Module.stringToUnitId -- moduleUnit = moduleUnitId -- unhelpfulSpanFS :: FS.FastString -> FS.FastString -- unhelpfulSpanFS = id -rtsUnit = Module.rtsUnitId #endif data GhcVersion @@ -596,13 +414,16 @@ data GhcVersion | GHC88 | GHC810 | GHC90 + | GHC92 deriving (Eq, Ord, Show) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) +ghcVersion = GHC92 +#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) ghcVersion = GHC90 #elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) ghcVersion = GHC810 @@ -611,3 +432,19 @@ ghcVersion = GHC88 #elif MIN_VERSION_GLASGOW_HASKELL(8,6,0,0) ghcVersion = GHC86 #endif + +runUnlit :: Logger -> DynFlags -> [Option] -> IO () +runUnlit = +#if MIN_VERSION_ghc(9,2,0) + SysTools.runUnlit +#else + const SysTools.runUnlit +#endif + +runPp :: Logger -> DynFlags -> [Option] -> IO () +runPp = +#if MIN_VERSION_ghc(9,2,0) + SysTools.runPp +#else + const SysTools.runPp +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/CPP.hs b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs new file mode 100644 index 0000000000..69fe1b7538 --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE CPP #-} +-- | Re-export 'doCpp' for GHC < 8.10. +-- +-- Later versions export what we need. +module Development.IDE.GHC.Compat.CPP ( + doCpp + ) where + +import FileCleanup +import Packages +import Panic +import SysTools +#if MIN_VERSION_ghc(8,8,2) +import LlvmCodeGen (llvmVersionList) +#elif MIN_VERSION_ghc(8,8,0) +import LlvmCodeGen (LlvmVersion (..)) +#endif +import DynFlags +import Module (toInstalledUnitId, rtsUnitId) +import Control.Monad +import Data.List (intercalate) +import Data.Maybe +import Data.Version +import System.Directory +import System.FilePath +import System.Info + +import Development.IDE.GHC.Compat as Compat + +doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO () +doCpp dflags raw input_fn output_fn = do + let hscpp_opts = picPOpts dflags + let cmdline_include_paths = includePaths dflags + + pkg_include_dirs <- getPackageIncludePath dflags [] + let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) [] + (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs) + let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) [] + (includePathsQuote cmdline_include_paths) + let include_paths = include_paths_quote ++ include_paths_global + + let verbFlags = getVerbFlags dflags + + let cpp_prog args | raw = SysTools.runCpp dflags args +#if MIN_VERSION_ghc(8,10,0) + | otherwise = SysTools.runCc Nothing +#else + | otherwise = SysTools.runCc +#endif + dflags (SysTools.Option "-E" : args) + + let target_defs = + -- NEIL: Patched to use System.Info instead of constants from CPP + [ "-D" ++ os ++ "_BUILD_OS", + "-D" ++ arch ++ "_BUILD_ARCH", + "-D" ++ os ++ "_HOST_OS", + "-D" ++ arch ++ "_HOST_ARCH" ] + -- remember, in code we *compile*, the HOST is the same our TARGET, + -- and BUILD is the same as our HOST. + + let sse_defs = + [ "-D__SSE__" | isSseEnabled dflags ] ++ + [ "-D__SSE2__" | isSse2Enabled dflags ] ++ + [ "-D__SSE4_2__" | isSse4_2Enabled dflags ] + + let avx_defs = + [ "-D__AVX__" | isAvxEnabled dflags ] ++ + [ "-D__AVX2__" | isAvx2Enabled dflags ] ++ + [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++ + [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++ + [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++ + [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ] + + backend_defs <- getBackendDefs dflags + + let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ] + -- Default CPP defines in Haskell source + ghcVersionH <- getGhcVersionPathName dflags + let hsSourceCppOpts = [ "-include", ghcVersionH ] + + -- MIN_VERSION macros + let uids = explicitPackages (pkgState dflags) + pkgs = catMaybes (map (lookupPackage dflags) uids) + mb_macro_include <- + if not (null pkgs) && gopt Opt_VersionMacros dflags + then do macro_stub <- newTempName dflags TFL_CurrentModule "h" + writeFile macro_stub (generatePackageVersionMacros pkgs) + -- Include version macros for every *exposed* package. + -- Without -hide-all-packages and with a package database + -- size of 1000 packages, it takes cpp an estimated 2 + -- milliseconds to process this file. See #10970 + -- comment 8. + return [SysTools.FileOption "-include" macro_stub] + else return [] + + cpp_prog ( map SysTools.Option verbFlags + ++ map SysTools.Option include_paths + ++ map SysTools.Option hsSourceCppOpts + ++ map SysTools.Option target_defs + ++ map SysTools.Option backend_defs + ++ map SysTools.Option th_defs + ++ map SysTools.Option hscpp_opts + ++ map SysTools.Option sse_defs + ++ map SysTools.Option avx_defs + ++ mb_macro_include + -- Set the language mode to assembler-with-cpp when preprocessing. This + -- alleviates some of the C99 macro rules relating to whitespace and the hash + -- operator, which we tend to abuse. Clang in particular is not very happy + -- about this. + ++ [ SysTools.Option "-x" + , SysTools.Option "assembler-with-cpp" + , SysTools.Option input_fn + -- We hackily use Option instead of FileOption here, so that the file + -- name is not back-slashed on Windows. cpp is capable of + -- dealing with / in filenames, so it works fine. Furthermore + -- if we put in backslashes, cpp outputs #line directives + -- with *double* backslashes. And that in turn means that + -- our error messages get double backslashes in them. + -- In due course we should arrange that the lexer deals + -- with these \\ escapes properly. + , SysTools.Option "-o" + , SysTools.FileOption "" output_fn + ]) + +getBackendDefs :: DynFlags -> IO [String] +getBackendDefs dflags | hscTarget dflags == HscLlvm = do + llvmVer <- figureLlvmVersion dflags + return $ case llvmVer of +#if MIN_VERSION_ghc(8,8,2) + Just v + | [m] <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, 0) ] + | m:n:_ <- llvmVersionList v -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m, n) ] +#elif MIN_VERSION_ghc(8,8,0) + Just (LlvmVersion n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (n,0) ] + Just (LlvmVersionOld m n) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ] +#else + Just n -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format n ] +#endif + _ -> [] + where + format (major, minor) + | minor >= 100 = error "getBackendDefs: Unsupported minor version" + | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int + +getBackendDefs _ = + return [] + +-- --------------------------------------------------------------------------- +-- Macros (cribbed from Cabal) + +generatePackageVersionMacros :: [Compat.UnitInfo] -> String +generatePackageVersionMacros pkgs = concat + -- Do not add any C-style comments. See #3389. + [ generateMacros "" pkgname version + | pkg <- pkgs + , let version = packageVersion pkg + pkgname = map fixchar (packageNameString pkg) + ] + +fixchar :: Char -> Char +fixchar '-' = '_' +fixchar c = c + +generateMacros :: String -> String -> Version -> String +generateMacros prefix name version = + concat + ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n" + ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n" + ," (major1) < ",major1," || \\\n" + ," (major1) == ",major1," && (major2) < ",major2," || \\\n" + ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" + ,"\n\n" + ] + where + (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) + + +-- | Find out path to @ghcversion.h@ file +getGhcVersionPathName :: DynFlags -> IO FilePath +getGhcVersionPathName dflags = do + candidates <- case ghcVersionFile dflags of + Just path -> return [path] + Nothing -> (map ( "ghcversion.h")) <$> + (getPackageIncludePath dflags [toInstalledUnitId rtsUnit]) + + found <- filterM doesFileExist candidates + case found of + [] -> throwGhcExceptionIO (InstallationError + ("ghcversion.h missing; tried: " + ++ intercalate ", " candidates)) + (x:_) -> return x + +rtsUnit :: UnitId +rtsUnit = Module.rtsUnitId diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs new file mode 100644 index 0000000000..f324123e7b --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -0,0 +1,740 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PatternSynonyms #-} +-- {-# OPTIONS -Wno-dodgy-imports #-} + +-- | Compat Core module that handles the GHC module hierarchy re-organisation +-- by re-exporting everything we care about. +-- +-- This module provides no other compat mechanisms, except for simple +-- backward-compatible pattern synonyms. +module Development.IDE.GHC.Compat.Core ( + -- * Exception handling + GhcException, + handleGhcException, + gcatch, + -- * Bags + Bag, + bagToList, + listToBag, + unionBags, + isEmptyBag, + -- * UniqueSupply + mkSplitUniqSupply, + -- * Maybes + MaybeErr(..), + orElse, +#if MIN_VERSION_ghc(8,10,0) + -- * Pair + Pair(..), +#endif + -- * Session + DynFlags, + packageFlags, + hiDir, + tmpDir, + importPaths, + useUnicode, + objectDir, + flagsForCompletion, + setImportPaths, + outputFile, + gopt, + gopt_set, + gopt_unset, + wopt, + wopt_set, + xopt, + xopt_set, + WarningFlag(..), + GeneralFlag(..), + PackageFlag, + pattern ExposePackage, + parseDynamicFilePragma, + WarnReason(..), + wWarningFlags, + flagSpecName, + flagSpecFlag, + updOptLevel, + -- slightly unsafe + setUnsafeGlobalDynFlags, + -- * ConLike + ConLike(..), + conLikeName, + conLikeFieldLabels, + dataConWrapId, + -- * Fingerprint + Fingerprint(..), + getFileHash, + fingerprintData, + fingerprintFingerprints, + -- * Interface Files + IfaceExport, + IfaceTyCon(..), +#if MIN_VERSION_ghc(8,10,0) + ModIface, + ModIface_(..), +#else + ModIface(..), +#endif + HscSource(..), + WhereFrom(..), + loadInterface, + SourceModified(..), + loadModuleInterface, + initIfaceLoad, + RecompileRequired(..), +#if MIN_VERSION_ghc(8,10,0) + mkPartialIface, + mkFullIface, +#else + mkIface, +#endif + checkOldIface, + -- * ModSummary + ModSummary(..), + -- * HomeModInfo + HomeModInfo(..), + -- * ModGuts + ModGuts(..), + CgGuts(..), + -- * ModDetails + ModDetails(..), + -- * NameCache + NameCache, + initNameCache, + -- * NameEnv + NameEnv, + nameEnvElts, + mkNameEnv, + unitNameEnv, + extendNameEnv, + lookupNameEnv, + -- * NameSpace + isTcClsNameSpace, + -- * Var + Type ( + TyCoRep.TyVarTy, + TyCoRep.AppTy, + TyCoRep.TyConApp, + TyCoRep.ForAllTy, + -- Omitted on purpose + -- pattern Synonym right below it + -- TyCoRep.FunTy, + TyCoRep.LitTy, + TyCoRep.CastTy, + TyCoRep.CoercionTy + ), + pattern FunTy, + isPredTy, + isDictTy, + isForAllTy, + isFunTy, + isPiTy, +#if MIN_VERSION_ghc(8,10,0) + coercionKind, + isCoercionTy_maybe, +#else + isCoercionTy, + splitCoercionType_maybe, +#endif + splitFunTys, + splitPiTys, + splitForAllTys, + TyThing(..), + binderVar, + Var, + varType, + varName, + mkVarOcc, + -- * TyCon + TyCon, + tyConName, + -- * Id + idName, + idType, + -- * GlobalRdrEnv + GlobalRdrEnv, + GlobalRdrElt(..), + lookupGlobalRdrEnv, + globalRdrEnvElts, + lookupGRE_Name, + -- * Specs + ImpDeclSpec(..), + ImportSpec(..), + -- * Name + Name, + isValName, + isSystemName, + isInternalName, + nameSrcSpan, + nameSrcLoc, + nameRdrName, + nameModule_maybe, + getSrcSpan, + RdrName(..), + mkRdrUnqual, + rdrNameFieldOcc, + OccName(..), + occName, + nameOccName, + rdrNameOcc, + parenSymOcc, + isValOcc, + isVarOcc, + isDataOcc, + isSymOcc, + isTcOcc, + occNameString, + isDataConName, + mkVarOccFS, + pprNameDefnLoc, + Parent(..), + -- * AvailInfo + Avail.AvailInfo, + pattern AvailName, + pattern AvailFL, + pattern AvailTC, + -- * NameSet + elemNameSet, + Avail.availsToNameSet, + -- * TcGblEnv + TcGblEnv(..), + -- * FieldLabel + FieldLabel, + flSelector, + flLabel, + -- * FastString exports + FastString, +#if MIN_VERSION_ghc(9,2,0) + -- Export here, so we can coerce safely on consumer sites + LexicalFastString(..), +#endif + uniq, + unpackFS, + fingerprintString, + mkFastString, + fsLit, + -- * Header Parser + getOptions, + -- * ErrUtils + Severity(..), + -- * String Buffer + StringBuffer(..), + hGetStringBuffer, + stringToStringBuffer, + -- * Parsing and Expr types + P(..), + PState(..), + ParseResult(..), + getMessages, +#if MIN_VERSION_ghc(8,10,0) + getErrorMessages, +#endif + HsParsedModule(..), + ParsedModule(..), + ParsedSource, + RenamedSource, + HsModule(..), + LHsContext, + HsContext, + LHsExpr, + HsExpr(..), + LIE, + IE(..), + ieNames, + IEWrappedName(..), + IEWildcard(..), + Pat(..), + LPat, + LHsDecl, + HsDecl(..), + TyClDecl(..), + HsDataDefn(..), + ConDecl(..), + InstDecl(..), +#if MIN_VERSION_ghc(9,0,0) + ClsInst, +#endif + ClsInstDecl(..), + DataFamInstDecl(..), + TyFamInstDecl(..), + FamEqn(..), + DerivDecl(..), + LSig, + Sig(..), + DefaultDecl(..), + ForeignDecl(..), + WarnDecls(..), + AnnDecl(..), + RuleDecls(..), + SpliceDecl(..), + DocDecl(..), + RoleAnnotDecl(..), + FamilyDecl(..), + HsConDetails(..), + LHsBind, + HsBind, + HsBindLR(..), + PatSynBind(..), + MatchGroup(..), + LHsType, + HsType(..), + LImportDecl, + ImportDecl(..), +#if MIN_VERSION_ghc(8,10,0) + ImportDeclQualifiedStyle(..), +#endif + HsWildCardBndrs(..), + HsImplicitBndrs(..), + LConDeclField, + ConDeclField(..), + HsValBindsLR(..), + LMatch, + Match(..), + StmtLR(..), + GRHS(..), + GRHSs(..), + HsLocalBinds, + HsLocalBindsLR(..), + parseHeader, + parseIdentifier, + parseModule, + parenthesizeHsExpr, + parenthesizeHsType, + parenthesizePat, + hsTypeNeedsParens, + sigPrec, + appPrec, + StringLiteral(..), + -- * Pat Syn + PatSyn, + mkPatSyn, + patSynBuilder, + patSynFieldLabels, + patSynIsInfix, + patSynMatcher, + patSynName, + patSynSig, + pprPatSynType, + -- * API Annotations + AnnKeywordId(..), + AnnotationComment(..), + -- * Compilation Main + HscEnv, + runGhc, + unGhc, + Session(..), + modifySession, + getSession, + setSessionDynFlags, + GhcMonad, + runHsc, + compileFile, + Phase(..), + hscDesugar, + hscGenHardCode, + hscInteractive, + hscSimplify, + hscTypecheckRename, + makeSimpleDetails, + -- * Typecheck utils + TcM, + initTc, + initTcWithGbl, + tcLookup, + TcTyThing(..), + tcRnImportDecls, + typecheckIface, + mkIfaceTc, + finalSafeMode, + ImportAvails(..), + ImportedModsVal(..), + importedByUser, + collectHsBindsBinders, + -- * Source Locations + HasSrcSpan, + Located, + unLoc, + getLoc, + SrcLoc.RealLocated, + GenLocated(..), + SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan), + SrcLoc.RealSrcSpan, + pattern RealSrcSpan, + SrcLoc.SrcLoc(..), + BufSpan, + SrcLoc.mkGeneralSrcSpan, + SrcLoc.mkRealSrcSpan, + SrcLoc.mkRealSrcLoc, + getRealSrcSpan, + SrcLoc.realSrcLocSpan, + SrcLoc.realSrcSpanStart, + SrcLoc.realSrcSpanEnd, + SrcLoc.isSubspanOf, + SrcLoc.wiredInSrcSpan, + SrcLoc.mkSrcSpan, + SrcLoc.srcSpanStart, + SrcLoc.srcSpanEnd, + SrcLoc.srcSpanFile, + SrcLoc.srcLocCol, + SrcLoc.srcLocLine, +#if !MIN_VERSION_ghc(8,10,0) && MIN_VERSION_ghc(8,8,0) + SrcLoc.dL, +#endif + -- * Finder + FindResult(..), + mkHomeModLocation, + findObjectLinkableMaybe, + InstalledFindResult(..), + -- * Module and Package + Module, + ModuleOrigin(..), + PackageName(..), + ModuleName, + moduleName, + mkModuleName, + mkModule, + moduleNameFS, + moduleNameSlashes, + moduleNameString, + ModuleEnv, + moduleEnvElts, + emptyModuleEnv, + extendModuleEnv, + moduleEnvToList, + extendInstalledModuleEnv, + -- * Linker + Unlinked(..), + Linkable(..), + unload, + initDynLinker, + -- * Doc Strings + extractDocs, + HsDocString, + DeclDocMap(..), + ArgDocMap(..), + -- * Hooks + Hooks, + runMetaHook, + MetaHook, + MetaRequest(..), + metaRequestE, + metaRequestP, + metaRequestT, + metaRequestD, + metaRequestAW, + -- * Tidy + tcInitTidyEnv, + tidyOpenType, + mkBootModDetailsTc, + tidyProgram, + -- * PrelInfo + mkPrelImports, + knownKeyNames, + -- * Wired-in + unitDataConId, + -- * Utils with no home, neither here nor in GHC + mkVarBind, + addBootSuffixLocnOut, + -- * HPT + addToHpt, + addListToHpt, + -- * Driver-Make + Target(..), + TargetId(..), + mkModuleGraph, + -- * GHCi + initObjLinker, + loadDLL, + -- * Panic + panic, + ) where + +import GHC hiding (HasSrcSpan, ModLocation, getLoc, + lookupName, RealSrcSpan, moduleUnitId, parseModule, + Phase) + +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC +import GHC.Builtin.Utils +import GHC.Builtin.Types +import GHC.Core.DataCon (dataConWrapId) +import GHC.Core.Coercion +import GHC.Core.ConLike (ConLike(..), conLikeName, conLikeFieldLabels) +#if !MIN_VERSION_ghc(9,2,0) +import GHC.Core.PatSyn +#endif +import qualified GHC.Core.TyCo.Rep as TyCoRep +import GHC.Core.TyCon +import GHC.Core.Type +import GHC.Core.Predicate +import GHC.Data.Bag +import GHC.Data.FastString +import GHC.Data.Maybe +import GHC.Data.StringBuffer +import GHC.Data.Pair +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Env +import GHC.Driver.Env.Types +#else +import GHC.Driver.Types +import GHC.Driver.Finder +#endif +import GHC.Driver.Main +import GHC.Driver.Hooks +import GHC.Driver.Monad +import GHC.Driver.Pipeline +import GHC.Driver.Phases +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags +#if !MIN_VERSION_ghc(9,2,0) +import GHC.HsToCore.Docs +#endif +import GHC.Iface.Load +import GHC.Iface.Make (mkIfaceExports, mkPartialIface, mkIfaceTc, mkFullIface) +import GHC.Iface.Tidy +import GHC.Iface.Type +import GHC.Iface.Recomp +import GHC.IfaceToCore +import GHC.Parser +import GHC.Parser.Header +#if MIN_VERSION_ghc(9,2,0) +import GHC.Linker.Loader +import GHC.Linker.Types +#else +import GHC.Parser.Lexer +import GHC.Runtime.Interpreter +import GHC.Runtime.Linker +#endif +import GHC.Tc.Module +import GHC.Tc.Types +import GHC.Tc.Utils.Env +import GHC.Tc.Utils.Monad +import qualified GHC.Types.Avail as Avail +import GHC.Types.FieldLabel +#if MIN_VERSION_ghc(9,2,0) +import GHC.Types.Meta +#else +import GHC.Types.Basic +import GHC.Types.Id +#endif +import GHC.Types.Name hiding (varName) +import GHC.Types.Name.Occurrence hiding (varName) +import GHC.Types.Name.Cache +import GHC.Types.Name.Env +import GHC.Types.Name.Reader +#if MIN_VERSION_ghc(9,2,0) +import GHC.Types.SourceFile (HscSource(..), SourceModified(..)) +#else +import GHC.Types.Name.Set +#endif +import GHC.Types.SrcLoc (BufSpan, getRealSrcSpan) +import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.Unique.Supply +import GHC.Types.Var +#if MIN_VERSION_ghc(9,2,0) +import GHC.Unit.Env +import GHC.Unit.Finder +import GHC.Unit.Home.ModInfo +#endif +import GHC.Unit.Info (PackageName(..)) +import GHC.Unit.Module.Env +#if MIN_VERSION_ghc(9,2,0) +import GHC.Unit.Module.ModGuts +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModIface (IfaceExport, mi_mod_hash) +#endif +import GHC.Unit.Module.Location +import GHC.Unit.Module.Name +import GHC.Unit.State (ModuleOrigin(..)) +import GHC.Unit.Types (UnitId, unitString, IsBootInterface(..)) +import GHC.Utils.Fingerprint +import GHC.Utils.Panic +import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) +#else +import Bag +import ConLike (ConLike(..), conLikeName, conLikeFieldLabels) +import DataCon (dataConWrapId) +import DynFlags hiding (ExposePackage) +import qualified DynFlags +import FastString +import FieldLabel (FieldLabel, flSelector, flLabel) +import Finder +import Fingerprint +import Maybes +import Module +#if MIN_VERSION_ghc(9,0,1) +import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) +import GHC.Core.TyCo.Ppr (pprSigmaType) +import GHC.Core.TyCo.Rep (Scaled, scaledThing) +import GHC.Iface.Load +import GHC.Types.Unique.Set (emptyUniqSet) +import Module (unitString) +#endif + +import qualified Avail +import HscTypes +import HeaderInfo +import NameEnv +import HscMain +import Hooks +import IfaceType +import Linker +import LoadIface +import MkIface +import Name hiding (varName) +import NameCache +import Packages +import Panic +import Parser +import PrelInfo +import RdrName +import qualified SrcLoc +import StringBuffer +import TcEnv +import TcIface +import TcRnDriver +import TcRnMonad +import qualified TyCoRep + +import TyCon +import UniqSupply +import Var +import TidyPgm +import DriverPipeline +import DriverPhases +import TysWiredIn +import BasicTypes +import Lexer +import GHCi +import ExtractDocs (extractDocs) +import PatSyn +import NameSet +import Id +import GhcMonad + +#if MIN_VERSION_ghc(8,10,0) +import TyCoTidy +import Predicate +import Type +import Pair +import Coercion (coercionKind) +#else +import SrcLoc (RealLocated) +import Type +#endif +#endif + +#if MIN_VERSION_ghc(9,2,0) +-- We are using Safe here, which is not equivalent, but probably what we want. +gcatch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a +gcatch = Safe.catch + +#elif MIN_VERSION_ghc(9,0,0) +-- We are using Safe here, which is not equivalent, but probably what we want. +gcatch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a +gcatch = Safe.catch +#endif + +#if !MIN_VERSION_ghc(9,0,0) +type BufSpan = () +#endif + +pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan +#if MIN_VERSION_ghc(9,0,0) +pattern RealSrcSpan x y = SrcLoc.RealSrcSpan x y +#else +pattern RealSrcSpan x y <- ((,Nothing) -> (SrcLoc.RealSrcSpan x, y)) where + RealSrcSpan x _ = SrcLoc.RealSrcSpan x +#endif +{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-} + + +pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo +#if __GLASGOW_HASKELL__ >= 902 +pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names, pieces) -> case gre of + Avail.NormalGreName name -> (name: names, pieces) + Avail.FieldGreName label -> (names, label:pieces)) ([], []) gres) -> (names, pieces)) +#else +pattern AvailTC n names pieces <- Avail.AvailTC n names pieces +#endif + +pattern AvailName :: Name -> Avail.AvailInfo +#if __GLASGOW_HASKELL__ >= 902 +pattern AvailName n <- Avail.Avail (Avail.NormalGreName n) +#else +pattern AvailName n <- Avail.Avail n +#endif + +pattern AvailFL :: FieldLabel -> Avail.AvailInfo +#if __GLASGOW_HASKELL__ >= 902 +pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl) +#else +-- pattern synonym that is never populated +pattern AvailFL x <- Avail.Avail ((\_ -> (True, undefined)) -> (False, x)) +#endif + +{-# COMPLETE AvailTC, AvailName, AvailFL #-} + +setImportPaths :: [FilePath] -> DynFlags -> DynFlags +setImportPaths importPaths flags = flags { importPaths = importPaths } + +pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag +-- https://github.com/facebook/fbghc +#ifdef __FACEBOOK_HASKELL__ +pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr +#else +pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr +#endif + +pattern FunTy :: Type -> Type -> Type +#if MIN_VERSION_ghc(8,10,0) +pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res} +#else +pattern FunTy arg res <- TyCoRep.FunTy arg res +#endif + +#if MIN_VERSION_ghc(9,0,0) +-- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x) +-- type HasSrcSpan x = () :: Constraint + +class HasSrcSpan a where + getLoc :: a -> SrcSpan + +instance HasSrcSpan (GenLocated SrcSpan a) where + getLoc = GHC.getLoc + +-- getLoc :: GenLocated l a -> l +-- getLoc = GHC.getLoc + +#elif MIN_VERSION_ghc(8,8,0) +type HasSrcSpan = SrcLoc.HasSrcSpan +getLoc :: SrcLoc.HasSrcSpan a => a -> SrcSpan +getLoc = SrcLoc.getLoc + +#else + +class HasSrcSpan a where + getLoc :: a -> SrcSpan +instance HasSrcSpan Name where + getLoc = nameSrcSpan +instance HasSrcSpan (GenLocated SrcSpan a) where + getLoc = SrcLoc.getLoc + +#endif + +#if !MIN_VERSION_ghc(8,8,0) + +-- | Add the @-boot@ suffix to all output file paths associated with the +-- module, not including the input file itself +addBootSuffixLocnOut :: ModLocation -> ModLocation +addBootSuffixLocnOut locn + = locn { ml_hi_file = Module.addBootSuffix (ml_hi_file locn) + , ml_obj_file = Module.addBootSuffix (ml_obj_file locn) + } + +getRealSrcSpan :: RealLocated a -> SrcLoc.RealSrcSpan +getRealSrcSpan = SrcLoc.getLoc +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs new file mode 100644 index 0000000000..b744545c13 --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE CPP #-} + +-- | Compat module for the main Driver types, such as 'HscEnv', +-- 'UnitEnv' and some DynFlags compat functions. +module Development.IDE.GHC.Compat.Env ( + Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph, hsc_HPT, hsc_type_env_var), + InteractiveContext(..), + Env.hsc_dflags, + hsc_logger, + hsc_tmpfs, + hsc_unit_env, + hsc_hooks, + hscSetHooks, + TmpFs, + -- * HomeUnit + hscHomeUnit, + HomeUnit, + setHomeUnitId_, + mkHomeModule, + -- * Export so other compats works better + Logger(..), + UnitEnv, + hscSetFlags, + initTempFs, + -- * Home Unit + homeUnitId_, + -- * DynFlags Helper + setBytecodeLinkerOptions, + Backend, + setBackend, + platformDefaultBackend, + ) where + +import GHC +#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Driver.Env as Env +import GHC.Unit.Env (UnitEnv) +import GHC.Utils.TmpFs +#else +import GHC.Driver.Types (InteractiveContext(..)) +import qualified GHC.Driver.Types as Env +#endif +import GHC.Driver.Hooks (Hooks) +import GHC.Unit.Types (UnitId, Unit) +import qualified GHC.Driver.Session as Home +import GHC.Driver.Session hiding (mkHomeModule) +#else +import HscTypes as Env +import Module (toInstalledUnitId) +import DynFlags (emptyFilesToClean, thisPackage, LogAction) +#if !MIN_VERSION_ghc(8,10,0) +import qualified DynFlags +#endif +import Hooks +#endif + +import Data.IORef + + +#if !MIN_VERSION_ghc(9,2,0) +type UnitEnv = () +newtype Logger = Logger { log_action :: LogAction } +type TmpFs = () +#endif + +setHomeUnitId_ :: UnitId -> DynFlags -> DynFlags +#if MIN_VERSION_ghc(9,2,0) +setHomeUnitId_ uid df = df { homeUnitId_ = uid } +#elif MIN_VERSION_ghc(9,0,0) +setHomeUnitId_ uid df = df { homeUnitId = uid } +#else +setHomeUnitId_ uid df = df { thisInstalledUnitId = toInstalledUnitId uid } +#endif + +hscSetFlags :: DynFlags -> HscEnv -> HscEnv +hscSetFlags df env = +#if MIN_VERSION_ghc(9,2,0) + hscSetFlags df env +#else + env { Env.hsc_dflags = df } +#endif + +initTempFs :: HscEnv -> IO HscEnv +initTempFs env = do +#if MIN_VERSION_ghc(9,2,0) + tmpFs <- initTmpFs + pure env { Env.hsc_tmpfs = tmpFs } +#else + filesToClean <- newIORef emptyFilesToClean + dirsToClean <- newIORef mempty + let dflags = (Env.hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean, useUnicode=True} + pure $ hscSetFlags dflags env +#endif + +hsc_unit_env :: HscEnv -> UnitEnv +hsc_unit_env = +#if MIN_VERSION_ghc(9,2,0) + Env.hsc_unit_env +#else + const () +#endif + +hsc_tmpfs :: HscEnv -> TmpFs +hsc_tmpfs = +#if MIN_VERSION_ghc(9,2,0) + Env.hsc_tmpfs +#else + const () +#endif + +hsc_logger :: HscEnv -> Logger +hsc_logger = +#if MIN_VERSION_ghc(9,2,0) + Env.hsc_logger +#else + Logger . GHC.log_action . Env.hsc_dflags +#endif + +hsc_hooks :: HscEnv -> Hooks +hsc_hooks = +#if MIN_VERSION_ghc(9,2,0) + Env.hsc_hooks +#else + hooks . Env.hsc_dflags +#endif + +hscSetHooks :: Hooks -> HscEnv -> HscEnv +hscSetHooks hooks env = +#if MIN_VERSION_ghc(9,2,0) + env { Env.hsc_hooks = hooks } +#else + hscSetFlags ((Env.hsc_dflags env) { hooks = hooks}) env +#endif + +homeUnitId_ :: DynFlags -> UnitId +homeUnitId_ = +#if MIN_VERSION_ghc(9,2,0) + homeUnitId_ +#elif MIN_VERSION_ghc(9,0,0) + homeUnitId +#else + thisPackage +#endif + + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +type HomeUnit = Unit +#elif !MIN_VERSION_ghc(9,0,0) +type HomeUnit = UnitId +#endif + +hscHomeUnit :: HscEnv -> HomeUnit +hscHomeUnit = +#if MIN_VERSION_ghc(9,2,0) + ue_home_unit . Env.hsc_unit_env +#elif MIN_VERSION_ghc(9,0,0) + homeUnit . Env.hsc_dflags +#else + homeUnitId_ . hsc_dflags +#endif + +mkHomeModule :: HomeUnit -> ModuleName -> Module +mkHomeModule = +#if MIN_VERSION_ghc(9,2,0) + Home.mkHomeModule +#else + mkModule +#endif + +-- | We don't want to generate object code so we compile to bytecode +-- (HscInterpreted) which implies LinkInMemory +-- HscInterpreted +setBytecodeLinkerOptions :: DynFlags -> DynFlags +setBytecodeLinkerOptions df = df { + ghcLink = LinkInMemory +#if MIN_VERSION_ghc(9,2,0) + , backend = NoBackend +#else + , hscTarget = HscNothing +#endif + , ghcMode = CompManager + } + + +#if !MIN_VERSION_ghc(9,2,0) +type Backend = HscTarget +#endif + +platformDefaultBackend :: DynFlags -> Backend +platformDefaultBackend = +#if MIN_VERSION_ghc(9,2,0) + platformDefaultBackend . targetPlatform +#elif MIN_VERSION_ghc(8,10,0) + defaultObjectTarget +#else + defaultObjectTarget . DynFlags.targetPlatform +#endif + +setBackend :: Backend -> DynFlags -> DynFlags +setBackend backend flags = +#if MIN_VERSION_ghc(9,2,0) + flags { backend = backend } +#else + flags { hscTarget = backend } +#endif + diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs new file mode 100644 index 0000000000..c6d8b5a31c --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP #-} + +-- | Compat module Interface file relevant code. +module Development.IDE.GHC.Compat.Iface ( + writeIfaceFile, + cannotFindModule, + ) where + +import GHC +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Iface.Load as Iface +import qualified GHC.Unit.Finder as Finder +import GHC.Unit.Finder.Types (FindResult) +#elif MIN_VERSION_ghc(9,0,0) +import qualified GHC.Iface.Load as Iface +import GHC.Driver.Types (FindResult) +import qualified GHC.Driver.Finder as Finder +#else +import qualified MkIface +import Finder (FindResult) +import qualified Finder +#endif + +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Outputable + +writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () +#if MIN_VERSION_ghc(9,2,0) +writeIfaceFile env fp iface = Iface.writeIface (hsc_logger) (hsc_dflags env) fp iface +#elif MIN_VERSION_ghc(9,0,0) +writeIfaceFile env = Iface.writeIface (hsc_dflags env) +#else +writeIfaceFile env = MkIface.writeIfaceFile (hsc_dflags env) +#endif + +cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc +cannotFindModule env modname fr = +#if MIN_VERSION_ghc(9,2,0) + Iface.cannotFindModule env modname fr +#else + Finder.cannotFindModule (hsc_dflags env) modname fr +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs new file mode 100644 index 0000000000..13c2fc45ea --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE CPP #-} +-- | Compat module for GHC 9.2 Logger infrastructure. +module Development.IDE.GHC.Compat.Logger ( + putLogHook, + pushLogHook, + -- * Logging stuff + LogActionCompat, + logActionCompat + ) where + +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env as Env +import Development.IDE.GHC.Compat.Outputable + +#if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Session as DynFlags +import GHC.Utils.Outputable +#else +import DynFlags +import Outputable (queryQual) +#endif + +putLogHook :: Logger -> HscEnv -> HscEnv +putLogHook logger env = + hscSetFlags ((hsc_dflags env) { DynFlags.log_action = Env.log_action logger }) env + +pushLogHook :: (LogAction -> LogAction) -> Logger -> Logger +pushLogHook f logger = + logger { Env.log_action = f (Env.log_action logger) } + +#if MIN_VERSION_ghc(9,0,0) +type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO () + +-- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. +logActionCompat :: LogActionCompat -> LogAction +logActionCompat logAction dynFlags wr severity loc = logAction dynFlags wr severity loc alwaysQualify + +#else +type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO () + +logActionCompat :: LogActionCompat -> LogAction +logActionCompat logAction dynFlags wr severity loc style = logAction dynFlags wr severity loc (queryQual style) +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs new file mode 100644 index 0000000000..fb9e22d13a --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE CPP #-} + +module Development.IDE.GHC.Compat.Outputable ( + SDoc, + Outputable, + showSDoc, + showSDocUnsafe, + showSDocForUser, + ppr, + pprPanic, + printSDocQualifiedUnsafe, + printNameWithoutUniques, + printSDocAllTheWay, + mkPrintUnqualified, + mkPrintUnqualifiedDefault, + PrintUnqualified(..), + -- * Parser errors + PsWarning, + PsError, + pprWarning, + pprError, + -- * Error infrastructure + DecoratedSDoc, + MsgEnvelope, + errMsgSpan, + errMsgSeverity, + formatErrorWithQual, + mkWarnMsg, + mkSrcErr, + srcErrorMessages, + ) where + + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Session +import GHC.Driver.Ppr +import qualified GHC.Types.Error as Error +import GHC.Types.SrcLoc +import GHC.Types.SourceError +import GHC.Unit.State (emptyUnitState) +import GHC.Utils.Error hiding (mkWarnMsg) +import GHC.Utils.Outputable +import GHC.Utils.Logger +import GHC.Utils.Panic +import GHC.Parser.Errors +import qualified GHC.Parser.Errors.Ppr as Ppr +#elif MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Types +import GHC.Driver.Session +import GHC.Utils.Outputable as Out +import GHC.Types.SrcLoc +import GHC.Utils.Error as Err hiding (mkWarnMsg) +import qualified GHC.Utils.Error as Err +import GHC.Types.Name.Reader (GlobalRdrEnv) +#else +import DynFlags +import Outputable as Out +import HscTypes +import qualified ErrUtils as Err +import SrcLoc +import ErrUtils hiding (mkWarnMsg) +import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) +#endif + + +printNameWithoutUniques :: Outputable a => a -> String +printNameWithoutUniques = +#if MIN_VERSION_ghc(9,2,0) + renderWithContext (defaultSDocContext { sdocSuppressUniques = True }) . ppr +#else + printSDocAllTheWay dyn . ppr + where + dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques +#endif + +printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String +printSDocQualifiedUnsafe unqual doc = +#if MIN_VERSION_ghc(9,2,0) + -- Taken from 'showSDocForUser' + renderWithContext (initSDocContext dflags sty) doc' + where + sty = mkUserStyle unqual AllTheWay + doc' = pprWithUnitState emptyUnitState doc +#else + showSDocForUser unsafeGlobalDynFlags unqual doc +#endif + +printSDocAllTheWay :: DynFlags -> SDoc -> String +#if MIN_VERSION_ghc(9,2,0) +printSDocAllTheWay dflags sdoc = renderWithContext ctxt sdoc + where + ctxt = initSDocContext dflags (mkUserStyle neverQualify AllTheWay) +#else +printSDocAllTheWay dflags sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags Out.neverQualify Out.AllTheWay) + +#if MIN_VERSION_ghc(9,0,0) +oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc +oldMkUserStyle _ = Out.mkUserStyle +oldMkErrStyle _ = Out.mkErrStyle + +oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc +oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext + where dummySDocContext = initSDocContext dflags Out.defaultUserStyle + +#else +oldRenderWithStyle :: DynFlags -> Out.SDoc -> Out.PprStyle -> String +oldRenderWithStyle = Out.renderWithStyle + +oldMkUserStyle :: DynFlags -> Out.PrintUnqualified -> Out.Depth -> Out.PprStyle +oldMkUserStyle = Out.mkUserStyle + +oldMkErrStyle :: DynFlags -> Out.PrintUnqualified -> Out.PprStyle +oldMkErrStyle = Out.mkErrStyle + +oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc +oldFormatErrDoc = Err.formatErrDoc +#endif +#endif + +pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc +pprWarning = +#if MIN_VERSION_ghc(9,2,0) + Ppr.pprWarning +#else + id +#endif + +pprError :: PsError -> MsgEnvelope DecoratedSDoc +pprError = +#if MIN_VERSION_ghc(9,2,0) + Ppr.pprError +#else + id +#endif + +formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String +formatErrorWithQual dflags e = +#if MIN_VERSION_ghc(9,2,0) + showSDoc dflags (pprLocMsgEnvelope e) +#else + Out.showSDoc dflags + $ Out.withPprStyle (oldMkErrStyle dflags $ errMsgContext e) + $ oldFormatErrDoc dflags + $ Err.errMsgDoc e +#endif + +#if !MIN_VERSION_ghc(9,2,0) +type DecoratedSDoc = () +type MsgEnvelope e = ErrMsg + +type PsWarning = ErrMsg +type PsError = ErrMsg +#endif + +-- | Like 'mkPrintUnqualified', but requires no additional context, +-- such as DynFlags or, in later GHC versions, UnitState by relying +-- on defaults. +mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified +mkPrintUnqualifiedDefault = +#if MIN_VERSION_ghc(9,2,0) + mkPrintUnqualified emptyUnitState +#else + mkPrintUnqualified unsafeGlobalDynFlags +#endif + + +mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc +mkWarnMsg = +#if MIN_VERSION_ghc(9,2,0) + const Error.mkWarnMsg +#else + Err.mkWarnMsg +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs new file mode 100644 index 0000000000..bf9ac42eec --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE CPP #-} + +-- | Parser compaibility module. +module Development.IDE.GHC.Compat.Parser ( + initParserOpts, + initParserState, +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) + -- in GHC == 9.2 the type doesn't exist + -- In GHC == 9.0 it is a data-type + -- and GHC < 9.0 it is type-def + -- + -- Export data-type here, otherwise only the simple type. + Anno.ApiAnns(..), +#else + ApiAnns, +#endif + mkHsParsedModule, + mkParsedModule, + mkApiAnns, + ) where + +import GHC (RealSrcLoc) + +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Parser.Lexer as Lexer +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Driver.Config as Config +#else +import qualified GHC.Parser.Annotation as Anno +#endif +#else +import Lexer +import StringBuffer +import qualified ApiAnnotation as Anno +import qualified SrcLoc +#endif +import Development.IDE.GHC.Compat.Core + +#if !MIN_VERSION_ghc(9,2,0) +import qualified Data.Map as Map + +type ParserOpts = DynFlags +#endif + +initParserOpts :: DynFlags -> ParserOpts +initParserOpts = +#if MIN_VERSION_ghc(9,2,0) + Config.initParserOpts +#else + id +#endif + +initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState +initParserState = +#if MIN_VERSION_ghc(9,2,0) + Lexer.initParserState +#else + Lexer.mkPState +#endif + +#if MIN_VERSION_ghc(9,2,0) +type ApiAnns = () +#else +type ApiAnns = Anno.ApiAnns +#endif + + +mkHsParsedModule :: ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule +mkHsParsedModule parsed fps hpm_annotations = + (HsParsedModule + parsed + fps +#if !MIN_VERSION_ghc(9,2,0) + hpm_annotations +#endif + ) + +mkParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule +mkParsedModule ms parsed extra_src_files _hpm_annotations = + ParsedModule { + pm_mod_summary = ms + , pm_parsed_source = parsed + , pm_extra_src_files = extra_src_files +#if !MIN_VERSION_ghc(9,2,0) + , pm_annotations = _hpm_annotations +#endif + } + +mkApiAnns :: PState -> ApiAnns +#if MIN_VERSION_ghc(9,2,0) +mkApiAnns = const () +#else +mkApiAnns pst = +#if MIN_VERSION_ghc(9,0,1) + -- Copied from GHC.Driver.Main + Anno.ApiAnns { + apiAnnItems = Map.fromListWith (++) $ annotations pst, + apiAnnEofPos = eof_pos pst, + apiAnnComments = Map.fromList (annotations_comments pst), + apiAnnRogueComments = comment_q pst + } +#else + (Map.fromListWith (++) $ annotations pst, + Map.fromList ((SrcLoc.noSrcSpan,comment_q pst) + :annotations_comments pst)) +#endif +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs new file mode 100644 index 0000000000..f16e35cca3 --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE CPP #-} + +-- | Plugin Compat utils. +module Development.IDE.GHC.Compat.Plugins ( + applyPluginsParsedResultAction, + initializePlugins, + ) where + +import GHC +#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Env +#else +import GHC.Driver.Types +#endif +import GHC.Driver.Plugins (Plugin (parsedResultAction), withPlugins) +import qualified GHC.Runtime.Loader as Loader +import GHC.Parser.Lexer +#else +import Plugins (Plugin(parsedResultAction), withPlugins ) +import qualified DynamicLoading as Loader +#endif +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) +import Development.IDE.GHC.Compat.Parser as Parser + +applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> IO (ParsedSource) +applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do + -- Apply parsedResultAction of plugins + let applyPluginAction p opts = parsedResultAction p opts ms + fmap hpm_module $ + runHsc env $ withPlugins +#if MIN_VERSION_ghc(9,2,0) + env +#else + dflags +#endif + applyPluginAction + (mkHsParsedModule parsed [] hpm_annotations) + +initializePlugins :: HscEnv -> IO HscEnv +initializePlugins env = do +#if MIN_VERSION_ghc(9,2,0) + Loader.initializePlugins env +#else + newDf <- Loader.initializePlugins env (hsc_dflags env) + pure $ hscSetFlags newDf env +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs new file mode 100644 index 0000000000..d56c83412b --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -0,0 +1,317 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} + +-- | Compat module for 'UnitState' and 'UnitInfo'. +module Development.IDE.GHC.Compat.Units ( + -- * UnitState + UnitState, + initUnits, + unitState, + getUnitName, + explicitUnits, + preloadClosureUs, + listVisibleModuleNames, + LookupResult(..), + lookupModuleWithSuggestions, + -- * UnitInfoMap + UnitInfoMap, + getUnitInfoMap, + lookupUnit, + lookupUnit', + -- * UnitInfo + UnitInfo, + unitExposedModules, + unitDepends, + unitHaddockInterfaces, + unitInfoId, + unitPackageNameString, + unitPackageVersion, + -- * UnitId helpers + UnitId, + Unit, +#if !MIN_VERSION_ghc(9,0,0) + pattern RealUnit, +#endif + definiteUnitId, + defUnitId, + installedModule, + -- * Module + toUnitId, + moduleUnitId, + moduleUnit, + -- * Utils + filterInplaceUnits, + ) where + +#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) +import GHC.Unit.Env +#else +import GHC.Driver.Session (PackageFlag(..), PackageArg(..)) +import qualified GHC.Driver.Session as DynFlags +#endif +import qualified GHC.Unit.Info as UnitInfo +import GHC.Unit.Module.Name (ModuleName) +import GHC.Unit.Types (UnitId, Unit, GenUnit(..), Definite(..), GenModule(Module), InstalledModule, Module) +import qualified GHC.Unit.Types as Unit +import GHC.Unit.State (UnitState(unitInfoMap), UnitInfo, PackageName, LookupResult) +import qualified GHC.Unit.State as State +import GHC.Types.Unique.Set +import GHC.Data.FastString +#else +import qualified DynFlags +import DynFlags (PackageFlag(..), PackageArg(..)) +import Packages (PackageState, PackageConfig, PackageConfigMap, lookupPackage', getPackageConfigMap, LookupResult, PackageName, InstalledPackageInfo (packageName, haddockInterfaces)) +import qualified Packages +import qualified Module +import Module hiding (moduleUnitId) +import FastString +#endif + +import Development.IDE.GHC.Compat.Env +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import Data.Map (Map) +#endif +import Data.Version +import Data.Either + +#if MIN_VERSION_ghc(9,0,0) +type PreloadUnitClosure = UniqSet UnitId +#if MIN_VERSION_ghc(9,2,0) +type UnitInfoMap = State.UnitInfoMap +#else +type UnitInfoMap = Map UnitId UnitInfo +#endif +#else +type UnitState = PackageState +type UnitInfo = PackageConfig +type UnitInfoMap = PackageConfigMap +type PreloadUnitClosure = () +type Unit = UnitId +#endif + +unitState :: HscEnv -> UnitState +#if MIN_VERSION_ghc(9,2,0) +unitState = ue_units . hsc_unit_env +#elif MIN_VERSION_ghc(9,0,0) +unitState = DynFlags.unitState . hsc_dflags +#else +unitState = DynFlags.pkgState . hsc_dflags +#endif + +initUnits :: HscEnv -> IO HscEnv +initUnits env = do +#if MIN_VERSION_ghc(9,2,0) + let dflags1 = hsc_dflags env + -- Copied from GHC.setSessionDynFlags + let old_unit_env = hsc_unit_env env + let cached_unit_dbs = ue_unit_dbs old_unit_env + (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits (hsc_logger env) dflags1 cached_unit_dbs + + dflags <- liftIO $ updatePlatformConstants dflags1 mconstants + + let unit_env = UnitEnv + { ue_platform = targetPlatform dflags + , ue_namever = ghcNameVersion dflags + , ue_home_unit = Just home_unit + , ue_hpt = ue_hpt old_unit_env + , ue_eps = ue_eps old_unit_env + , ue_units = unit_state + , ue_unit_dbs = Just dbs + } + pure $ hscSetFlags dflags env { hsc_unit_env = unit_env } +#elif MIN_VERSION_ghc(9,0,0) + newFlags <- State.initUnits $ hsc_dflags env + pure $ hscSetFlags newFlags env +#else + newFlags <- fmap fst . Packages.initPackages $ hsc_dflags env + pure $ hscSetFlags newFlags env +#endif + +explicitUnits :: UnitState -> [Unit] +explicitUnits ue = +#if MIN_VERSION_ghc(9,0,0) + State.explicitUnits ue +#else + Packages.explicitPackages ue +#endif + +listVisibleModuleNames :: HscEnv -> [ModuleName] +listVisibleModuleNames env = +#if MIN_VERSION_ghc(9,0,0) + State.listVisibleModuleNames $ unitState env +#else + Packages.listVisibleModuleNames $ hsc_dflags env +#endif + +getUnitName :: HscEnv -> UnitId -> Maybe PackageName +getUnitName env i = +#if MIN_VERSION_ghc(9,0,0) + State.unitPackageName <$> State.lookupUnitId (unitState env) i +#else + packageName <$> Packages.lookupPackage (hsc_dflags env) (definiteUnitId (defUnitId i)) +#endif + +lookupModuleWithSuggestions :: HscEnv -> ModuleName -> Maybe FastString -> LookupResult +lookupModuleWithSuggestions env modname mpkg = +#if MIN_VERSION_ghc(9,0,0) + State.lookupModuleWithSuggestions (unitState env) modname mpkg +#else + Packages.lookupModuleWithSuggestions (hsc_dflags env) modname mpkg +#endif + +getUnitInfoMap :: HscEnv -> UnitInfoMap +getUnitInfoMap = +#if MIN_VERSION_ghc(9,2,0) + unitInfoMap . ue_units . hsc_unit_env +#elif MIN_VERSION_ghc(9,0,0) + unitInfoMap . unitState +#else + Packages.getPackageConfigMap . hsc_dflags +#endif + +lookupUnit :: HscEnv -> Unit -> Maybe UnitInfo +#if MIN_VERSION_ghc(9,0,0) +lookupUnit env pid = State.lookupUnit (unitState env) pid +#else +lookupUnit env pid = Packages.lookupPackage (hsc_dflags env) pid +#endif + +lookupUnit' :: Bool -> UnitInfoMap -> PreloadUnitClosure -> Unit -> Maybe UnitInfo +#if MIN_VERSION_ghc(9,0,0) +lookupUnit' = State.lookupUnit' +#else +lookupUnit' b pcm _ u = Packages.lookupPackage' b pcm u +#endif + +preloadClosureUs :: HscEnv -> PreloadUnitClosure +#if MIN_VERSION_ghc(9,2,0) +preloadClosureUs = State.preloadClosure . unitState +#elif MIN_VERSION_ghc(9,0,0) +preloadClosureUs = State.preloadClosure . unitState +#else +preloadClosureUs = const () +#endif + +unitExposedModules :: UnitInfo -> [(ModuleName, Maybe Module)] +unitExposedModules ue = +#if MIN_VERSION_ghc(9,0,0) + UnitInfo.unitExposedModules ue +#else + Packages.exposedModules ue +#endif + +unitDepends :: UnitInfo -> [UnitId] +#if MIN_VERSION_ghc(9,0,0) +unitDepends = State.unitDepends +#else +unitDepends = fmap (Module.DefiniteUnitId. defUnitId') . Packages.depends +#endif + +unitPackageNameString :: UnitInfo -> String +unitPackageNameString = +#if MIN_VERSION_ghc(9,0,0) + UnitInfo.unitPackageNameString +#else + Packages.packageNameString +#endif + +unitPackageVersion :: UnitInfo -> Version +unitPackageVersion = +#if MIN_VERSION_ghc(9,0,0) + UnitInfo.unitPackageVersion +#else + Packages.packageVersion +#endif + +unitInfoId :: UnitInfo -> Unit +unitInfoId = +#if MIN_VERSION_ghc(9,0,0) + UnitInfo.mkUnit +#else + Packages.packageConfigId +#endif + +unitHaddockInterfaces :: UnitInfo -> [FilePath] +unitHaddockInterfaces = +#if MIN_VERSION_ghc(9,0,0) + UnitInfo.unitHaddockInterfaces +#else + haddockInterfaces +#endif + +-- ------------------------------------------------------------------ +-- Backwards Compatible UnitState +-- ------------------------------------------------------------------ + +-- ------------------------------------------------------------------ +-- Patterns and helpful definitions +-- ------------------------------------------------------------------ + +#if MIN_VERSION_ghc(9,2,0) +definiteUnitId = RealUnit +defUnitId = Definite +installedModule = Module + +#elif MIN_VERSION_ghc(9,0,0) +definiteUnitId = RealUnit +defUnitId = Definite +installedModule = Module + +#else +pattern RealUnit :: Module.DefUnitId -> UnitId +pattern RealUnit x = Module.DefiniteUnitId x + +definiteUnitId :: Module.DefUnitId -> UnitId +definiteUnitId = Module.DefiniteUnitId + +defUnitId :: UnitId -> Module.DefUnitId +defUnitId = Module.DefUnitId . Module.toInstalledUnitId + +defUnitId' :: Module.InstalledUnitId -> Module.DefUnitId +defUnitId' = Module.DefUnitId + +installedModule :: UnitId -> ModuleName -> Module.InstalledModule +installedModule uid modname = Module.InstalledModule (Module.toInstalledUnitId uid) modname +#endif + +toUnitId :: Unit -> UnitId +toUnitId = +#if MIN_VERSION_ghc(9,0,0) + Unit.toUnitId +#else + id +#endif + +moduleUnitId :: Module -> UnitId +moduleUnitId = +#if MIN_VERSION_ghc(9,0,0) + Unit.toUnitId . Unit.moduleUnit +#else + Module.moduleUnitId +#endif + +moduleUnit :: Module -> Unit +moduleUnit = +#if MIN_VERSION_ghc(9,0,0) + Unit.moduleUnit +#else + Module.moduleUnitId +#endif + +filterInplaceUnits :: [UnitId] -> [PackageFlag] -> ([UnitId], [PackageFlag]) +filterInplaceUnits us packageFlags = + partitionEithers (map isInplace packageFlags) + where + isInplace :: PackageFlag -> Either UnitId PackageFlag + isInplace p@(ExposePackage _ (UnitIdArg u) _) = +#if MIN_VERSION_ghc(9,0,0) + if toUnitId u `elem` us + then Left $ toUnitId u + else Right p +#else + if u `elem` us + then Left u + else Right p +#endif + isInplace p = Right p diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index f025957e8d..eb412685fc 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -29,22 +29,15 @@ module Development.IDE.GHC.Error , toDSeverity ) where -import Bag import Data.Maybe import Data.String (fromString) import qualified Data.Text as T -import qualified Development.IDE.GHC.Compat as GHC +import qualified Development.IDE.GHC.Compat as Compat +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics as D import Development.IDE.Types.Location -import ErrUtils -import qualified FastString as FS import GHC -import HscTypes -import qualified Outputable as Out -import Panic -import SrcLoc - diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic @@ -60,32 +53,25 @@ diagFromText diagSource sev loc msg = (toNormalizedFilePath' $ fromMaybe noFileP } -- | Produce a GHC-style error from a source span and a message. -diagFromErrMsg :: T.Text -> DynFlags -> ErrMsg -> [FileDiagnostic] +diagFromErrMsg :: T.Text -> DynFlags -> MsgEnvelope DecoratedSDoc -> [FileDiagnostic] diagFromErrMsg diagSource dflags e = [ diagFromText diagSource sev (errMsgSpan e) $ T.pack $ formatErrorWithQual dflags e | Just sev <- [toDSeverity $ errMsgSeverity e]] -formatErrorWithQual :: DynFlags -> ErrMsg -> String -formatErrorWithQual dflags e = - Out.showSDoc dflags - $ Out.withPprStyle (GHC.oldMkErrStyle dflags $ errMsgContext e) - $ GHC.oldFormatErrDoc dflags - $ ErrUtils.errMsgDoc e - -diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic] -diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList +diagFromErrMsgs :: T.Text -> DynFlags -> Compat.Bag (MsgEnvelope DecoratedSDoc) -> [FileDiagnostic] +diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . Compat.bagToList -- | Convert a GHC SrcSpan to a DAML compiler Range srcSpanToRange :: SrcSpan -> Maybe Range srcSpanToRange (UnhelpfulSpan _) = Nothing -srcSpanToRange (GHC.OldRealSrcSpan real) = Just $ realSrcSpanToRange real +srcSpanToRange (Compat.RealSrcSpan real _) = Just $ realSrcSpanToRange real -- srcSpanToRange = fmap realSrcSpanToRange . realSpan realSrcSpanToRange :: RealSrcSpan -> Range realSrcSpanToRange real = - Range (realSrcLocToPosition $ realSrcSpanStart real) - (realSrcLocToPosition $ realSrcSpanEnd real) + Range (realSrcLocToPosition $ Compat.realSrcSpanStart real) + (realSrcLocToPosition $ Compat.realSrcSpanEnd real) realSrcLocToPosition :: RealSrcLoc -> Position realSrcLocToPosition real = @@ -95,12 +81,12 @@ realSrcLocToPosition real = -- FIXME This may not be an _absolute_ file name, needs fixing. srcSpanToFilename :: SrcSpan -> Maybe FilePath srcSpanToFilename (UnhelpfulSpan _) = Nothing -srcSpanToFilename (GHC.OldRealSrcSpan real) = Just $ FS.unpackFS $ srcSpanFile real +srcSpanToFilename (Compat.RealSrcSpan real _) = Just $ Compat.unpackFS $ srcSpanFile real -- srcSpanToFilename = fmap (FS.unpackFS . srcSpanFile) . realSpan realSrcSpanToLocation :: RealSrcSpan -> Location realSrcSpanToLocation real = Location file (realSrcSpanToRange real) - where file = fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ FS.unpackFS $ srcSpanFile real + where file = fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' $ Compat.unpackFS $ srcSpanFile real srcSpanToLocation :: SrcSpan -> Maybe Location srcSpanToLocation src = do @@ -110,18 +96,18 @@ srcSpanToLocation src = do pure $ Location (fromNormalizedUri $ filePathToUri' $ toNormalizedFilePath' fs) rng rangeToSrcSpan :: NormalizedFilePath -> Range -> SrcSpan -rangeToSrcSpan = fmap GHC.OldRealSrcSpan . rangeToRealSrcSpan +rangeToSrcSpan = fmap (\x -> Compat.RealSrcSpan x Nothing) . rangeToRealSrcSpan rangeToRealSrcSpan :: NormalizedFilePath -> Range -> RealSrcSpan rangeToRealSrcSpan nfp = - mkRealSrcSpan + Compat.mkRealSrcSpan <$> positionToRealSrcLoc nfp . _start <*> positionToRealSrcLoc nfp . _end positionToRealSrcLoc :: NormalizedFilePath -> Position -> RealSrcLoc positionToRealSrcLoc nfp (Position l c)= - mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (l + 1) (c + 1) + Compat.mkRealSrcLoc (fromString $ fromNormalizedFilePath nfp) (l + 1) (c + 1) isInsideSrcSpan :: Position -> SrcSpan -> Bool p `isInsideSrcSpan` r = case srcSpanToRange r of @@ -152,19 +138,19 @@ diagFromString diagSource sev sp x = [diagFromText diagSource sev sp $ T.pack x] -- | Produces an "unhelpful" source span with the given string. noSpan :: String -> SrcSpan -noSpan = GHC.oldUnhelpfulSpan . FS.fsLit +noSpan = Compat.mkGeneralSrcSpan . Compat.fsLit -- | creates a span with zero length in the filename of the argument passed -zeroSpan :: FS.FastString -- ^ file path of span +zeroSpan :: Compat.FastString -- ^ file path of span -> RealSrcSpan -zeroSpan file = realSrcLocSpan (mkRealSrcLoc file 1 1) +zeroSpan file = Compat.realSrcLocSpan (Compat.mkRealSrcLoc file 1 1) realSpan :: SrcSpan -> Maybe RealSrcSpan realSpan = \case - GHC.OldRealSrcSpan r -> Just r - UnhelpfulSpan _ -> Nothing + Compat.RealSrcSpan r _ -> Just r + UnhelpfulSpan _ -> Nothing -- | Catch the errors thrown by GHC (SourceErrors and @@ -172,7 +158,7 @@ realSpan = \case -- diagnostics catchSrcErrors :: DynFlags -> T.Text -> IO a -> IO (Either [FileDiagnostic] a) catchSrcErrors dflags fromWhere ghcM = do - handleGhcException (ghcExceptionToDiagnostics dflags) $ + Compat.handleGhcException (ghcExceptionToDiagnostics dflags) $ handleSourceError (sourceErrorToDiagnostics dflags) $ Right <$> ghcM where @@ -192,14 +178,14 @@ showGHCE dflags exc = case exc of -> unwords ["Compilation Issue:", s, "\n", requestReport] PprPanic s sdoc -> unlines ["Compilation Issue", s,"" - , Out.showSDoc dflags sdoc + , Compat.showSDoc dflags sdoc , requestReport ] Sorry s -> "Unsupported feature: " <> s PprSorry s sdoc -> unlines ["Unsupported feature: ", s,"" - , Out.showSDoc dflags sdoc] + , Compat.showSDoc dflags sdoc] ---------- errors below should not happen at all -------- @@ -216,6 +202,6 @@ showGHCE dflags exc = case exc of -> "Program error: " <> str PprProgramError str sdoc -> unlines ["Program error:", str,"" - , Out.showSDoc dflags sdoc] + , Compat.showSDoc dflags sdoc] where requestReport = "Please report this bug to the compiler authors." diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index bf564452d4..3bbdc231bb 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -32,7 +32,6 @@ module Development.IDE.GHC.ExactPrint ) where -import BasicTypes (appPrec) import Control.Applicative (Alternative) import Control.Arrow import Control.Monad @@ -53,7 +52,7 @@ import Data.Traversable (for) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat hiding (parseExpr) +import Development.IDE.GHC.Compat import Development.IDE.Graph (RuleResult, Rules) import Development.IDE.Graph.Classes import Development.IDE.Types.Location @@ -65,9 +64,6 @@ import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers import Language.LSP.Types import Language.LSP.Types.Capabilities (ClientCapabilities) -import Outputable (Outputable, ppr, - showSDoc) -import Parser (parseIdentifier) import Retrie.ExactPrint hiding (parseDecl, parseExpr, parsePattern, diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 97c38b1d58..1483d1cdc4 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -9,20 +9,34 @@ -- Note that the 'NFData' instances may not be law abiding. module Development.IDE.GHC.Orphans() where +#if MIN_VERSION_ghc(9,0,0) +import GHC.Data.Bag +import GHC.Data.FastString +import qualified GHC.Data.StringBuffer as SB +import GHC.Types.Name.Occurrence +import GHC.Types.SrcLoc +import GHC.Types.Unique (getKey, getUnique) +import GHC.Unit.Info +import GHC.Utils.Outputable +#else import Bag +import GhcPlugins +import qualified StringBuffer as SB +import Unique (getKey) +#endif + +import GHC + +import Retrie.ExactPrint (Annotated) + +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Util + import Control.DeepSeq import Data.Aeson import Data.Hashable import Data.String (IsString (fromString)) import Data.Text (Text) -import Development.IDE.GHC.Compat -import Development.IDE.GHC.Util -import GHC () -import GhcPlugins -import Retrie.ExactPrint (Annotated) -import qualified StringBuffer as SB -import Unique (getKey) - -- Orphan instances for types from the GHC API. instance Show CoreModule where show = prettyPrint @@ -50,7 +64,7 @@ instance NFData GhcPlugins.InstalledUnitId where rnf = rwhnf . installedUnitIdFS instance Hashable GhcPlugins.InstalledUnitId where hashWithSalt salt = hashWithSalt salt . installedUnitIdString #else -instance Show InstalledUnitId where show = prettyPrint +instance Show UnitId where show = prettyPrint deriving instance Ord SrcSpan deriving instance Ord UnhelpfulSpanReason #endif @@ -93,8 +107,10 @@ deriving instance Show SourceModified instance NFData SourceModified where rnf = rwhnf +#if !MIN_VERSION_ghc(9,2,0) instance Show ModuleName where show = moduleNameString +#endif instance Hashable ModuleName where hashWithSalt salt = hashWithSalt salt . show diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index fd13dd8f27..7c41f3eda6 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -30,6 +30,48 @@ module Development.IDE.GHC.Util( disableWarningsAsErrors, ) where +#if MIN_VERSION_ghc(9,2,0) +import GHC +import GHC.Core.Multiplicity +import qualified GHC.Core.TyCo.Rep as TyCoRep +import GHC.Data.StringBuffer +import GHC.Data.FastString +import GHC.Driver.Env +import GHC.Driver.Env.Types +import GHC.Driver.Monad +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags +import GHC.Hs.Extension +import qualified GHC.Hs.Type as GHC +import GHC.Iface.Env (updNameCache) +import GHC.Iface.Make (mkIfaceExports) +import qualified GHC.Linker.Types as LinkerTypes +import GHC.Parser.Lexer +import GHC.Unit.Env +import GHC.Unit.Info (PackageName) +import qualified GHC.Unit.Info as Packages +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModGuts +import GHC.Unit.Module.ModIface (mi_mod_hash) +import GHC.Unit.Module.Name (moduleNameSlashes) +import qualified GHC.Unit.Module.Location as Module +import qualified GHC.Unit.Types as Module +import GHC.Unit.Types (unitString, IsBootInterface(..)) +import qualified GHC.Unit.State as Packages +import GHC.Utils.Outputable +import qualified GHC.Utils.Outputable as Outputable +import GHC.Utils.Fingerprint +import GHC.Runtime.Context +import GHC.Tc.Types (TcGblEnv(tcg_exports)) +import GHC.Tc.Utils.TcType (pprSigmaType) +import GHC.Types.Avail +import GHC.Types.Name.Reader +import GHC.Types.Name.Cache +import GHC.Types.Name.Occurrence +import GHC.Types.SrcLoc +import qualified GHC.Types.SrcLoc as SrcLoc +#endif +import GHC import Control.Concurrent import Control.Exception import Data.Binary.Put (Put, runPut) @@ -45,10 +87,9 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import Data.Typeable import Development.IDE.GHC.Compat as GHC +import qualified Development.IDE.GHC.Compat.Units as Compat +import qualified Development.IDE.GHC.Compat.Parser as Compat import Development.IDE.Types.Location -import FastString (mkFastString) -import FileCleanup -import Fingerprint import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable @@ -58,20 +99,7 @@ import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals import GHC.IO.Handle.Types -import GhcMonad -import HscTypes (CgGuts, HscEnv (hsc_dflags), - ModDetails, cg_binds, - cg_module, hsc_IC, ic_dflags, - md_types) -import Lexer -import Module (moduleNameSlashes) -import OccName (parenSymOcc) -import Outputable (Depth (..), Outputable, SDoc, - neverQualify, ppr, - showSDocUnsafe) -import RdrName (nameRdrName, rdrNameOcc) -import SrcLoc (mkRealSrcLoc) -import StringBuffer + import System.FilePath @@ -86,19 +114,15 @@ modifyDynFlags f = do -- We do not use setSessionDynFlags here since we handle package -- initialization separately. modifySession $ \h -> - h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} } + hscSetFlags newFlags h { hsc_IC = (hsc_IC h) {ic_dflags = newFlags} } -- | Given a 'Unit' try and find the associated 'PackageConfig' in the environment. -lookupPackageConfig :: Unit -> HscEnv -> Maybe GHC.PackageConfig +lookupPackageConfig :: Unit -> HscEnv -> Maybe GHC.UnitInfo lookupPackageConfig unit env = - -- GHC.lookupPackage' False pkgConfigMap unit - GHC.lookupUnit' False pkgConfigMap prClsre unit + Compat.lookupUnit' False unitState prClsre unit where - pkgConfigMap = - -- For some weird reason, the GHC API does not provide a way to get the PackageConfigMap - -- from PackageState so we have to wrap it in DynFlags first. - getPackageConfigMap $ hsc_dflags env - prClsre = preloadClosureUs $ hsc_dflags env + unitState = Compat.getUnitInfoMap env + prClsre = preloadClosureUs env -- | Convert from the @text@ package to the @GHC@ 'StringBuffer'. @@ -112,7 +136,7 @@ runParser flags str parser = unP parser parseState filename = "" location = mkRealSrcLoc (mkFastString filename) 1 1 buffer = stringToStringBuffer str - parseState = mkPState flags buffer location + parseState = Compat.initParserState (Compat.initParserOpts flags) buffer location stringBufferToByteString :: StringBuffer -> ByteString stringBufferToByteString StringBuffer{..} = PS buf cur len @@ -125,9 +149,7 @@ prettyPrint :: Outputable a => a -> String prettyPrint = unsafePrintSDoc . ppr unsafePrintSDoc :: SDoc -> String -unsafePrintSDoc sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags neverQualify AllTheWay) - where - dflags = unsafeGlobalDynFlags +unsafePrintSDoc sdoc = showSDocUnsafe sdoc -- | Pretty print a 'RdrName' wrapping operators in parens printRdrName :: RdrName -> String @@ -148,13 +170,9 @@ evalGhcEnv env act = snd <$> runGhcEnv env act -- pieces, but designed to be more efficient than a standard 'runGhc'. runGhcEnv :: HscEnv -> Ghc a -> IO (HscEnv, a) runGhcEnv env act = do - filesToClean <- newIORef emptyFilesToClean - dirsToClean <- newIORef mempty - let dflags = (hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean, useUnicode=True} - ref <- newIORef env{hsc_dflags=dflags} - res <- unGhc act (Session ref) `finally` do - cleanTempFiles dflags - cleanTempDirs dflags + hsc_env <- initTempFs env + ref <- newIORef hsc_env + res <- unGhc (withCleanupSession act) (Session ref) (,res) <$> readIORef ref -- | Given a module location, and its parse tree, figure out what is the include directory implied by it. diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs index df7ef0fb39..39d851f0cc 100644 --- a/ghcide/src/Development/IDE/GHC/Warnings.hs +++ b/ghcide/src/Development/IDE/GHC/Warnings.hs @@ -5,14 +5,10 @@ module Development.IDE.GHC.Warnings(withWarnings) where import Data.List -import ErrUtils -import GhcPlugins as GHC hiding (Var, (<>)) - import Control.Concurrent.Strict import qualified Data.Text as T -import Development.IDE.GHC.Compat (LogActionCompat, - logActionCompat) +import Development.IDE.GHC.Compat import Development.IDE.GHC.Error import Development.IDE.Types.Diagnostics import Language.LSP.Types (type (|?) (..)) @@ -27,16 +23,20 @@ import Language.LSP.Types (type (|?) (..)) -- https://github.com/ghc/ghc/blob/5f1d949ab9e09b8d95319633854b7959df06eb58/compiler/main/GHC.hs#L623-L640 -- which basically says that log_action is taken from the ModSummary when GHC feels like it. -- The given argument lets you refresh a ModSummary log_action -withWarnings :: T.Text -> ((ModSummary -> ModSummary) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a) +withWarnings :: T.Text -> ((HscEnv -> HscEnv) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a) withWarnings diagSource action = do warnings <- newVar [] let newAction :: LogActionCompat newAction dynFlags wr _ loc prUnqual msg = do let wr_d = map ((wr,) . third3 (attachReason wr)) $ diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc prUnqual msg modifyVar_ warnings $ return . (wr_d:) - res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = logActionCompat newAction}} + newLogger env = pushLogHook (const (logActionCompat newAction)) (hsc_logger env) + res <- action $ \env -> putLogHook (newLogger env) env warns <- readVar warnings return (reverse $ concat warns, res) + where + third3 :: (c -> d) -> (a, b, c) -> (a, b, d) + third3 f (a, b, c) = (a, b, f c) attachReason :: WarnReason -> Diagnostic -> Diagnostic attachReason wr d = d{_code = InR <$> showReason wr} diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 572a17c569..32de8a8c85 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -18,20 +18,13 @@ import Development.IDE.GHC.Error as ErrUtils import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location --- GHC imports import Control.DeepSeq -import FastString -import Finder -import qualified Module as M -import Outputable (ppr, pprPanic, showSDoc) -import Packages -- standard imports import Control.Monad.Extra import Control.Monad.IO.Class import Data.List (isSuffixOf) import Data.Maybe -import DriverPhases import System.FilePath data Import @@ -75,7 +68,7 @@ locateModuleFile :: MonadIO m -> m (Maybe NormalizedFilePath) locateModuleFile import_dirss exts targetFor isSource modName = do let candidates import_dirs = - [ toNormalizedFilePath' (prefix M.moduleNameSlashes modName <.> maybeBoot ext) + [ toNormalizedFilePath' (prefix moduleNameSlashes modName <.> maybeBoot ext) | prefix <- import_dirs , ext <- exts] firstJustM (targetFor modName) (concatMap candidates import_dirss) where @@ -87,22 +80,22 @@ locateModuleFile import_dirss exts targetFor isSource modName = do -- It only returns Just for unit-ids which are possible to import into the -- current module. In particular, it will return Nothing for 'main' components -- as they can never be imported into another package. -mkImportDirs :: DynFlags -> (Compat.InstalledUnitId, DynFlags) -> Maybe (PackageName, [FilePath]) -mkImportDirs df (i, DynFlags{importPaths}) = (, importPaths) <$> getPackageName df i +mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, [FilePath]) +mkImportDirs env (i, flags) = (, importPaths flags) <$> getUnitName env i -- | locate a module in either the file system or the package database. Where we go from *daml to -- Haskell locateModule :: MonadIO m - => DynFlags - -> [(Compat.InstalledUnitId, DynFlags)] -- ^ Import directories + => HscEnv + -> [(UnitId, DynFlags)] -- ^ Import directories -> [String] -- ^ File extensions -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)) -- ^ does file exist predicate -> Located ModuleName -- ^ Module name -> Maybe FastString -- ^ Package name -> Bool -- ^ Is boot module -> m (Either [FileDiagnostic] Import) -locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do +locateModule env comp_info exts targetFor modName mbPkgName isSource = do case mbPkgName of -- "this" means that we should only look in the current package Just "this" -> do @@ -111,7 +104,7 @@ locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do Just pkgName | Just dirs <- lookup (PackageName pkgName) import_paths -> lookupLocal [dirs] - | otherwise -> lookupInPackageDB dflags + | otherwise -> lookupInPackageDB env Nothing -> do -- first try to find the module as a file. If we can't find it try to find it in the package -- database. @@ -120,10 +113,11 @@ locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do -- each component will end up being found in the wrong place and cause a multi-cradle match failure. mbFile <- locateModuleFile (importPaths dflags : map snd import_paths) exts targetFor isSource $ unLoc modName case mbFile of - Nothing -> lookupInPackageDB dflags + Nothing -> lookupInPackageDB env Just file -> toModLocation file where - import_paths = mapMaybe (mkImportDirs dflags) comp_info + dflags = hsc_dflags env + import_paths = mapMaybe (mkImportDirs env) comp_info toModLocation file = liftIO $ do loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file) return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource) @@ -131,20 +125,21 @@ locateModule dflags comp_info exts targetFor modName mbPkgName isSource = do lookupLocal dirs = do mbFile <- locateModuleFile dirs exts targetFor isSource $ unLoc modName case mbFile of - Nothing -> return $ Left $ notFoundErr dflags modName $ LookupNotFound [] + Nothing -> return $ Left $ notFoundErr env modName $ LookupNotFound [] Just file -> toModLocation file - lookupInPackageDB dfs = - case oldLookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of + lookupInPackageDB env = + case Compat.lookupModuleWithSuggestions env (unLoc modName) mbPkgName of LookupFound _m _pkgConfig -> return $ Right PackageImport - reason -> return $ Left $ notFoundErr dfs modName reason + reason -> return $ Left $ notFoundErr env modName reason -- | Don't call this on a found module. -notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnostic] -notFoundErr dfs modName reason = - mkError' $ ppr' $ cannotFindModule dfs modName0 $ lookupToFindResult reason +notFoundErr :: HscEnv -> Located ModuleName -> LookupResult -> [FileDiagnostic] +notFoundErr env modName reason = + mkError' $ ppr' $ cannotFindModule env modName0 $ lookupToFindResult reason where - mkError' = diagFromString "not found" DsError (getLoc modName) + dfs = hsc_dflags env + mkError' = diagFromString "not found" DsError (Compat.getLoc modName) modName0 = unLoc modName ppr' = showSDoc dfs -- We convert the lookup result to a find result to reuse GHC's cannotFindMoudle pretty printer. @@ -155,12 +150,12 @@ notFoundErr dfs modName reason = LookupMultiple rs -> FoundMultiple rs LookupHidden pkg_hiddens mod_hiddens -> notFound - { fr_pkgs_hidden = map (moduleUnitId . fst) pkg_hiddens - , fr_mods_hidden = map (moduleUnitId . fst) mod_hiddens + { fr_pkgs_hidden = map (moduleUnit . fst) pkg_hiddens + , fr_mods_hidden = map (moduleUnit . fst) mod_hiddens } LookupUnusable unusable -> let unusables' = map get_unusable unusable - get_unusable (m, ModUnusable r) = (moduleUnitId m, r) + get_unusable (m, ModUnusable r) = (moduleUnit m, r) get_unusable (_, r) = pprPanic "findLookupResult: unexpected origin" (ppr r) in notFound {fr_unusables = unusables'} diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 44714f23d7..82bdc573cd 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -29,8 +29,6 @@ import Language.LSP.Types (DocumentSymbol (..), SymbolKind (SkConstructor, SkField, SkFile, SkFunction, SkInterface, SkMethod, SkModule, SkObject, SkStruct, SkTypeParameter, SkUnknown), TextDocumentIdentifier (TextDocumentIdentifier), type (|?) (InL), uriToFilePath) -import Outputable (Outputable, ppr, - showSDocUnsafe) moduleOutline :: IdeState -> DocumentSymbolParams -> LspM c (Either ResponseError (List DocumentSymbol |? List SymbolInformation)) @@ -44,7 +42,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif -> let declSymbols = mapMaybe documentSymbolForDecl hsmodDecls moduleSymbol = hsmodName >>= \case - (L (OldRealSrcSpan l) m) -> Just $ + (L (RealSrcSpan l _) m) -> Just $ (defDocumentSymbol l :: DocumentSymbol) { _name = pprText m , _kind = SkFile @@ -73,7 +71,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif Nothing -> pure $ Right $ InL (List []) documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol -documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } })) +documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n <> (case pprText fdTyVars of @@ -83,7 +81,7 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ FamDecl { tcdFam = FamilyDe , _detail = Just $ pprText fdInfo , _kind = SkFunction } -documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars })) +documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName name <> (case pprText tcdTyVars of @@ -99,11 +97,11 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ ClassDecl { tcdLName = L _ , _kind = SkMethod , _selectionRange = realSrcSpanToRange l' } - | L (OldRealSrcSpan l) (ClassOpSig _ False names _) <- tcdSigs - , L (OldRealSrcSpan l') n <- names + | L (RealSrcSpan l _) (ClassOpSig _ False names _) <- tcdSigs + , L (RealSrcSpan l' _) n <- names ] } -documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } })) +documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName name , _kind = SkStruct @@ -115,8 +113,8 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ n , _selectionRange = realSrcSpanToRange l' , _children = conArgRecordFields (con_args x) } - | L (OldRealSrcSpan l ) x <- dd_cons - , L (OldRealSrcSpan l') n <- getConNames' x + | L (RealSrcSpan l _ ) x <- dd_cons + , L (RealSrcSpan l' _) n <- getConNames' x ] } where @@ -127,48 +125,48 @@ documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ DataDecl { tcdLName = L _ n , _kind = SkField } | L _ cdf <- lcdfs - , L (OldRealSrcSpan l) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf + , L (RealSrcSpan l _) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf ] conArgRecordFields _ = Nothing -documentSymbolForDecl (L (OldRealSrcSpan l) (TyClD _ SynDecl { tcdLName = L (OldRealSrcSpan l') n })) = Just +documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ SynDecl { tcdLName = L (RealSrcSpan l' _) n })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n , _kind = SkTypeParameter , _selectionRange = realSrcSpanToRange l' } -documentSymbolForDecl (L (OldRealSrcSpan l) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } })) +documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty , _kind = SkInterface } -documentSymbolForDecl (L (OldRealSrcSpan l) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) +documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords (map pprText feqn_pats) , _kind = SkInterface } -documentSymbolForDecl (L (OldRealSrcSpan l) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) +documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords (map pprText feqn_pats) , _kind = SkInterface } -documentSymbolForDecl (L (OldRealSrcSpan l) (DerivD _ DerivDecl { deriv_type })) = +documentSymbolForDecl (L (RealSrcSpan l _) (DerivD _ DerivDecl { deriv_type })) = gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) -> (defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs) name , _kind = SkInterface } -documentSymbolForDecl (L (OldRealSrcSpan l) (ValD _ FunBind{fun_id = L _ name})) = Just +documentSymbolForDecl (L (RealSrcSpan l _) (ValD _ FunBind{fun_id = L _ name})) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName name , _kind = SkFunction } -documentSymbolForDecl (L (OldRealSrcSpan l) (ValD _ PatBind{pat_lhs})) = Just +documentSymbolForDecl (L (RealSrcSpan l _) (ValD _ PatBind{pat_lhs})) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText pat_lhs , _kind = SkFunction } -documentSymbolForDecl (L (OldRealSrcSpan l) (ForD _ x)) = Just +documentSymbolForDecl (L (RealSrcSpan l _) (ForD _ x)) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = case x of ForeignImport{} -> name @@ -202,7 +200,7 @@ documentSymbolForImportSummary importSymbols = } documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol -documentSymbolForImport (L (OldRealSrcSpan l) ImportDecl { ideclName, ideclQualified }) = Just +documentSymbolForImport (L (RealSrcSpan l _) ImportDecl { ideclName, ideclQualified }) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = "import " <> pprText ideclName , _kind = SkModule diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 43354a11e9..cc535d1d8f 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -18,8 +18,6 @@ module Development.IDE.Plugin.CodeAction , matchRegExMultipleImports ) where -import Bag (bagToList, - isEmptyBag) import Control.Applicative ((<|>)) import Control.Arrow (second, (>>>)) @@ -57,8 +55,6 @@ import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options import qualified GHC.LanguageExtensions as Lang -import HscTypes (ImportedModsVal (..), - importedByUser) import Ide.PluginUtils (subRange) import Ide.Types import qualified Language.LSP.Server as LSP @@ -77,18 +73,6 @@ import Language.LSP.Types (CodeAction ( type (|?) (InR), uriToFilePath) import Language.LSP.VFS -import Module (moduleEnvElts) -import OccName -import Outputable (Outputable, - ppr, - showSDoc, - showSDocUnsafe) -import RdrName (GlobalRdrElt (..), - lookupGlobalRdrEnv) -import SrcLoc (realSrcSpanEnd, - realSrcSpanStart) -import TcRnTypes (ImportAvails (..), - TcGblEnv (..)) import Text.Regex.TDFA (mrAfter, (=~), (=~~)) @@ -256,7 +240,7 @@ suggestHideShadow ps@(L _ HsModule {hsmodImports}) fileContents mTcM mHar Diagno | Just tcM <- mTcM, Just har <- mHar, [s'] <- [x | (x, "") <- readSrcSpan $ T.unpack s], - isUnusedImportedId tcM har (T.unpack identifier) (T.unpack modName) (OldRealSrcSpan s'), + isUnusedImportedId tcM har (T.unpack identifier) (T.unpack modName) (RealSrcSpan s' Nothing), mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName, title <- "Hide " <> identifier <> " from " <> modName = if modName == "Prelude" && null mDecl @@ -440,10 +424,10 @@ suggestDeleteUnusedBinding findRelatedSpans indexedContent name - (L (OldRealSrcSpan l) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) = + (L (RealSrcSpan l _) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) = case lname of (L nLoc _name) | isTheBinding nLoc -> - let findSig (L (OldRealSrcSpan l) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig + let findSig (L (RealSrcSpan l _) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig findSig _ = [] in extendForSpaces indexedContent (toRange l) : @@ -466,7 +450,7 @@ suggestDeleteUnusedBinding let maybeSpan = findRelatedSigSpan1 name sig in case maybeSpan of Just (_span, True) -> pure $ extendForSpaces indexedContent $ toRange l -- a :: Int - Just (OldRealSrcSpan span, False) -> pure $ toRange span -- a, b :: Int, a is unused + Just (RealSrcSpan span _, False) -> pure $ toRange span -- a, b :: Int, a is unused _ -> [] -- Second of the tuple means there is only one match @@ -517,10 +501,10 @@ suggestDeleteUnusedBinding indexedContent name lsigs - (L (OldRealSrcSpan l) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) = + (L (RealSrcSpan l _) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) = if isTheBinding (getLoc lname) then - let findSig (L (OldRealSrcSpan l) sig) = findRelatedSigSpan indexedContent name l sig + let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig findSig _ = [] in extendForSpaces indexedContent (toRange l) : concatMap findSig lsigs else concatMap (findRelatedSpanForMatch indexedContent name) matches @@ -562,7 +546,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul -- we get the last export and the closing bracket and check for comma in that range needsComma :: T.Text -> Located [LIE GhcPs] -> Bool needsComma _ (L _ []) = False - needsComma source (L (OldRealSrcSpan l) exports) = + needsComma source (L (RealSrcSpan l _) exports) = let closeParan = _end $ realSrcSpanToRange l lastExport = fmap _end . getLocatedRange $ last exports in case lastExport of @@ -690,7 +674,7 @@ newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text - newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ | Range _ lastLineP : _ <- [ realSrcSpanToRange sp - | (L l@(OldRealSrcSpan sp) _) <- hsmodDecls + | (L l@(RealSrcSpan sp _) _) <- hsmodDecls , _start `isInsideSrcSpan` l] , nextLineP <- Position{ _line = _line lastLineP + 1, _character = 0} = [ ("Define " <> sig @@ -1015,10 +999,10 @@ disambiguateSymbol pm fileContents Diagnostic {..} (T.unpack -> symbol) = \case liftParseAST @(HsExpr GhcPs) df $ prettyPrint $ HsVar @GhcPs noExtField $ - L (oldUnhelpfulSpan "") rdr + L (mkGeneralSrcSpan "") rdr else Rewrite (rangeToSrcSpan "" _range) $ \df -> liftParseAST @RdrName df $ - prettyPrint $ L (oldUnhelpfulSpan "") rdr + prettyPrint $ L (mkGeneralSrcSpan "") rdr ] findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs) @@ -1301,8 +1285,14 @@ newImportToEdit (unNewImport -> imp) ps fileContents newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange (L _ HsModule {..}) fileContents | Just (uncurry Position -> insertPos, col) <- case hsmodImports of - [] -> findPositionNoImports hsmodName hsmodExports fileContents - _ -> findPositionFromImportsOrModuleDecl hsmodImports last True + [] -> case getLoc (head hsmodDecls) of + RealSrcSpan s _ -> let col = srcLocCol (realSrcSpanStart s) - 1 + in Just ((srcLocLine (realSrcSpanStart s) - 1, col), col) + _ -> Nothing + _ -> case getLoc (last hsmodImports) of + RealSrcSpan s _ -> let col = srcLocCol (realSrcSpanStart s) - 1 + in Just ((srcLocLine $ realSrcSpanEnd s,col), col) + _ -> Nothing = Just (Range insertPos insertPos, col) | otherwise = Nothing diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 2f552e782f..0771ef6cc8 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -29,21 +29,16 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromJust, isNothing, mapMaybe) import qualified Data.Text as T -import Development.IDE.GHC.Compat hiding (parseExpr) +import Development.IDE.GHC.Compat import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), Annotate) import Development.IDE.Spans.Common -import FieldLabel (flLabel) import GHC.Exts (IsList (fromList)) -import GhcPlugins (mkRdrUnqual, sigPrec) import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey) import Language.LSP.Types -import OccName -import Outputable (ppr, showSDocUnsafe) -import Retrie.GHC (rdrNameOcc, unpackFS) ------------------------------------------------------------------------------ diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 9b1b203262..b5e1449619 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} @@ -48,11 +47,6 @@ import Ide.Types import qualified Language.LSP.Server as LSP import Language.LSP.Types import qualified Language.LSP.VFS as VFS -#if MIN_VERSION_ghc(9,0,0) -import GHC.Tc.Module (tcRnImportDecls) -#else -import TcRnDriver (tcRnImportDecls) -#endif descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index c3f1de1a4a..610c7a68ab 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -26,17 +26,6 @@ import Data.Maybe (fromMaybe, isJust, import qualified Data.Text as T import qualified Text.Fuzzy as Fuzzy -import HscTypes -import Name -import RdrName -import Type -#if MIN_VERSION_ghc(8,10,0) -import Coercion -import Pair -import Predicate (isDictTy) -#endif - -import ConLike import Control.Monad import Data.Aeson (ToJSON (toJSON)) import Data.Either (fromRight) @@ -46,7 +35,7 @@ import qualified Data.Set as Set import qualified Data.HashSet as HashSet import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat as GHC hiding (ppr) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types @@ -56,15 +45,12 @@ import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Exports import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Options -import GhcPlugins (flLabel, unpackFS) import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), PluginId) import Language.LSP.Types import Language.LSP.Types.Capabilities import qualified Language.LSP.VFS as VFS -import Outputable (Outputable) -import TyCoRep -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs @@ -334,7 +320,7 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do packageState = hscEnv env curModName = moduleName curMod - importMap = Map.fromList [ (l, imp) | imp@(L (OldRealSrcSpan l) _) <- limports ] + importMap = Map.fromList [ (l, imp) | imp@(L (RealSrcSpan l _) _) <- limports ] iDeclToModName :: ImportDecl name -> ModuleName iDeclToModName = unLoc . ideclName diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index b8660887b6..3eea61d146 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -9,11 +9,11 @@ module Development.IDE.Plugin.Completions.Types ( import Control.DeepSeq import qualified Data.Map as Map import qualified Data.Text as T -import SrcLoc import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Development.IDE.Spans.Common +import Development.IDE.GHC.Compat import GHC.Generics (Generic) import Ide.Plugin.Config (Config) import Ide.Plugin.Properties diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index 1dbe0b2a38..fdbb05e257 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -34,7 +34,6 @@ import Development.IDE.Types.Action import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import Development.IDE.Types.Location (fromUri) import GHC.Generics (Generic) -import GhcPlugins (HscEnv (hsc_dflags)) import Ide.Types import qualified Language.LSP.Server as LSP import Language.LSP.Types diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 327ac65513..da73a35ece 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -12,7 +12,6 @@ module Development.IDE.Plugin.TypeLenses ( GlobalBindingTypeSigsResult (..), ) where -import Avail (availsToNameSet) import Control.DeepSeq (rwhnf) import Control.Monad (mzero) import Control.Monad.Extra (whenMaybe) @@ -42,13 +41,6 @@ import Development.IDE.Types.Location (Position (Position, _chara toNormalizedFilePath', uriToFilePath') import GHC.Generics (Generic) -import GhcPlugins (GlobalRdrEnv, - HscEnv (hsc_dflags), SDoc, - elemNameSet, getSrcSpan, - idName, mkRealSrcLoc, - realSrcLocSpan, - tidyOpenType) -import HscTypes (mkPrintUnqualified) import Ide.Plugin.Config (Config) import Ide.Plugin.Properties import Ide.PluginUtils (mkLspCommand, @@ -73,16 +65,6 @@ import Language.LSP.Types (ApplyWorkspaceEditParams ( TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit)) -import Outputable (showSDocForUser) -import PatSyn (PatSyn, mkPatSyn, - patSynBuilder, - patSynFieldLabels, - patSynIsInfix, - patSynMatcher, patSynName, - patSynSig, pprPatSynType) -import TcEnv (tcInitTidyEnv) -import TcRnMonad (initTcWithGbl) -import TcRnTypes (TcGblEnv (..)) import Text.Regex.TDFA ((=~), (=~~)) typeLensCommandId :: T.Text @@ -185,7 +167,7 @@ suggestLocalSignature isQuickFix mTmr mBindings Diagnostic{_message, _range = _r , Just TcModuleResult{tmrTypechecked = TcGblEnv{tcg_rdr_env, tcg_sigs}} <- mTmr , -- not a top-level thing, to avoid duplication not $ name `elemNameSet` tcg_sigs - , tyMsg <- showSDocForUser unsafeGlobalDynFlags (mkPrintUnqualified unsafeGlobalDynFlags tcg_rdr_env) $ pprSigmaType ty + , tyMsg <- printSDocQualifiedUnsafe (mkPrintUnqualifiedDefault tcg_rdr_env) $ pprSigmaType ty , signature <- T.pack $ printName name <> " :: " <> tyMsg , startCharacter <- _character _start , startOfLine <- Position (_line _start) startCharacter diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 2c878ebe1b..bed9b9e44a 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -33,22 +33,12 @@ import Development.IDE.GHC.Compat import Development.IDE.Spans.Common import Development.IDE.Types.Options --- GHC API imports -import FastString (unpackFS) -import IfaceType -import Name -import NameEnv -import Outputable hiding ((<>)) -import SrcLoc -import TyCoRep hiding (FunTy) -import TyCon -import qualified Var - import Control.Applicative import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe +import Data.Coerce (coerce) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M import Data.Maybe @@ -130,12 +120,12 @@ referencesAtPoint hiedb nfp pos refs = do Just mod -> do -- Look for references (strictly in project files, not dependencies), -- excluding the files in the FOIs (since those are in foiRefs) - rows <- liftIO $ findReferences hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) exclude + rows <- liftIO $ findReferences hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) exclude pure $ mapMaybe rowToLoc rows typeRefs <- forM names $ \name -> case nameModule_maybe name of Just mod | isTcClsNameSpace (occNameSpace $ nameOccName name) -> do - refs <- liftIO $ findTypeRefs hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) exclude + refs <- liftIO $ findTypeRefs hiedb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) exclude pure $ mapMaybe typeRowToLoc refs _ -> pure [] pure $ nubOrd $ foiRefs ++ concat nonFOIRefs ++ concat typeRefs @@ -208,10 +198,10 @@ atPoint :: IdeOptions -> HieAstResult -> DocAndKindMap - -> DynFlags + -> HscEnv -> Position -> Maybe (Maybe Range, [T.Text]) -atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ pointCommand hf pos hoverInfo +atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ pointCommand hf pos hoverInfo where -- Hover info for values/data hoverInfo ast = (Just range, prettyNames ++ pTypes) @@ -240,10 +230,10 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ po prettyPackageName n = do m <- nameModule_maybe n - let pid = moduleUnitId m - conf <- lookupPackage df pid - let pkgName = T.pack $ packageNameString conf - version = T.pack $ showVersion (packageVersion conf) + let pid = moduleUnit m + conf <- lookupUnit env pid + let pkgName = T.pack $ unitPackageNameString conf + version = T.pack $ showVersion (unitPackageVersion conf) pure $ " *(" <> pkgName <> "-" <> version <> ")*" prettyTypes = map (("_ :: "<>) . prettyType) types @@ -300,10 +290,10 @@ typeLocationsAtPoint hiedb lookupModule _ideOptions pos (HAR _ ast _ _ hieKind) in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation hiedb lookupModule) (getTypes ts) namesInType :: Type -> [Name] -namesInType (TyVarTy n) = [Var.varName n] +namesInType (TyVarTy n) = [varName n] namesInType (AppTy a b) = getTypes [a,b] namesInType (TyConApp tc ts) = tyConName tc : getTypes ts -namesInType (ForAllTy b t) = Var.varName (binderVar b) : namesInType t +namesInType (ForAllTy b t) = varName (binderVar b) : namesInType t namesInType (FunTy a b) = getTypes [a,b] namesInType (CastTy t _) = namesInType t namesInType (LitTy _) = [] @@ -333,7 +323,7 @@ locationsAtPoint hiedb lookupModule _ideOptions imports pos ast = nameToLocation :: MonadIO m => HieDb -> LookupModule m -> Name -> m (Maybe [Location]) nameToLocation hiedb lookupModule name = runMaybeT $ case nameSrcSpan name of - sp@(OldRealSrcSpan rsp) + sp@(RealSrcSpan rsp _) -- Lookup in the db if we got a location in a boot file | fs <- unpackFS (srcSpanFile rsp) , not $ "boot" `isSuffixOf` fs @@ -353,7 +343,7 @@ nameToLocation hiedb lookupModule name = runMaybeT $ -- In this case the interface files contain garbage source spans -- so we instead read the .hie files to get useful source spans. mod <- MaybeT $ return $ nameModule_maybe name - erow <- liftIO $ findDef hiedb (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) + erow <- liftIO $ findDef hiedb (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) case erow of [] -> do -- If the lookup failed, try again without specifying a unit-id. @@ -398,7 +388,17 @@ defRowToSymbolInfo _ = Nothing pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a] pointCommand hf pos k = catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast -> - case selectSmallestContaining (sp fs) ast of + -- Since GHC 9.2: + -- getAsts :: Map HiePath (HieAst a) + -- type HiePath = LexialFastString + -- + -- but before: + -- getAsts :: Map HiePath (HieAst a) + -- type HiePath = FastString + -- + -- 'coerce' here to avoid an additional function for maintaining + -- backwards compatibility. + case selectSmallestContaining (sp $ coerce fs) ast of Nothing -> Nothing Just ast' -> Just $ k ast' where diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 895379e89a..d7b4535a7a 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -23,20 +23,14 @@ import Data.Maybe import qualified Data.Text as T import GHC.Generics -import ConLike -import DynFlags import GHC -import NameEnv -import Outputable hiding ((<>)) -import Var -import Development.IDE.GHC.Compat (oldMkUserStyle, - oldRenderWithStyle) +import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util import qualified Documentation.Haddock.Parser as H import qualified Documentation.Haddock.Types as H -import RdrName (rdrNameOcc) type DocMap = NameEnv SpanDoc type KindMap = NameEnv TyThing @@ -48,11 +42,7 @@ showSD :: SDoc -> T.Text showSD = T.pack . unsafePrintSDoc showNameWithoutUniques :: Outputable a => a -> T.Text -showNameWithoutUniques = T.pack . prettyprint - where - dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques - prettyprint x = oldRenderWithStyle dyn (ppr x) style - style = oldMkUserStyle dyn neverQualify AllTheWay +showNameWithoutUniques = T.pack . printNameWithoutUniques -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier. unqualIEWrapName :: IEWrappedName RdrName -> T.Text @@ -66,9 +56,9 @@ safeTyThingType (ATyCon tycon) = Just (tyConKind tycon) safeTyThingType _ = Nothing safeTyThingId :: TyThing -> Maybe Id -safeTyThingId (AnId i) = Just i -safeTyThingId (AConLike conLike) = conLikeWrapId_maybe conLike -safeTyThingId _ = Nothing +safeTyThingId (AnId i) = Just i +safeTyThingId (AConLike (RealDataCon dataCon)) = Just (dataConWrapId dataCon) +safeTyThingId _ = Nothing -- Possible documentation for an element in the code data SpanDoc diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 95cc889d40..9b52942e2a 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -13,6 +13,7 @@ module Development.IDE.Spans.Documentation ( ) where import Control.Monad +import Control.Monad.IO.Class import Control.Monad.Extra (findM) import Data.Either import Data.Foldable @@ -29,15 +30,7 @@ import Development.IDE.Spans.Common import System.Directory import System.FilePath -import ExtractDocs -import FastString -import GhcMonad -import HscTypes (HscEnv (hsc_dflags)) import Language.LSP.Types (filePathToUri, getUri) -import Name -import NameEnv -import SrcLoc (RealLocated) -import TcRnTypes mkDocMap :: HscEnv @@ -86,12 +79,11 @@ getDocumentationsTryGhc env mod names = do -- Get the uris to the documentation and source html pages if they exist getUris name = do - let df = hsc_dflags env (docFu, srcFu) <- case nameModule_maybe name of Just mod -> liftIO $ do - doc <- toFileUriText $ lookupDocHtmlForModule df mod - src <- toFileUriText $ lookupSrcHtmlForModule df mod + doc <- toFileUriText $ lookupDocHtmlForModule env mod + src <- toFileUriText $ lookupSrcHtmlForModule env mod return (doc, src) Nothing -> pure (Nothing, Nothing) let docUri = (<> "#" <> selector <> showNameWithoutUniques name) <$> docFu @@ -183,28 +175,28 @@ docHeaders = mapMaybe (\(L _ x) -> wrk x) -- | Given a module finds the local @doc/html/Foo-Bar-Baz.html@ page. -- An example for a cabal installed module: -- @~/.cabal/store/ghc-8.10.1/vctr-0.12.1.2-98e2e861/share/doc/html/Data-Vector-Primitive.html@ -lookupDocHtmlForModule :: DynFlags -> Module -> IO (Maybe FilePath) +lookupDocHtmlForModule :: HscEnv -> Module -> IO (Maybe FilePath) lookupDocHtmlForModule = lookupHtmlForModule (\pkgDocDir modDocName -> pkgDocDir modDocName <.> "html") -- | Given a module finds the hyperlinked source @doc/html/src/Foo.Bar.Baz.html@ page. -- An example for a cabal installed module: -- @~/.cabal/store/ghc-8.10.1/vctr-0.12.1.2-98e2e861/share/doc/html/src/Data.Vector.Primitive.html@ -lookupSrcHtmlForModule :: DynFlags -> Module -> IO (Maybe FilePath) +lookupSrcHtmlForModule :: HscEnv -> Module -> IO (Maybe FilePath) lookupSrcHtmlForModule = lookupHtmlForModule (\pkgDocDir modDocName -> pkgDocDir "src" modDocName <.> "html") -lookupHtmlForModule :: (FilePath -> FilePath -> FilePath) -> DynFlags -> Module -> IO (Maybe FilePath) -lookupHtmlForModule mkDocPath df m = do +lookupHtmlForModule :: (FilePath -> FilePath -> FilePath) -> HscEnv -> Module -> IO (Maybe FilePath) +lookupHtmlForModule mkDocPath hscEnv m = do -- try all directories - let mfs = fmap (concatMap go) (lookupHtmls df ui) + let mfs = fmap (concatMap go) (lookupHtmls hscEnv ui) html <- findM doesFileExist (concat . maybeToList $ mfs) -- canonicalize located html to remove /../ indirection which can break some clients -- (vscode on Windows at least) traverse canonicalizePath html where go pkgDocDir = map (mkDocPath pkgDocDir) mns - ui = moduleUnitId m + ui = moduleUnit m -- try to locate html file from most to least specific name e.g. -- first Language.LSP.Types.Uri.html and Language-Haskell-LSP-Types-Uri.html -- then Language.LSP.Types.html and Language-Haskell-LSP-Types.html etc. @@ -213,8 +205,8 @@ lookupHtmlForModule mkDocPath df m = do -- The file might use "." or "-" as separator map (`intercalate` chunks) [".", "-"] -lookupHtmls :: DynFlags -> Unit -> Maybe [FilePath] +lookupHtmls :: HscEnv -> Unit -> Maybe [FilePath] lookupHtmls df ui = -- use haddockInterfaces instead of haddockHTMLs: GHC treats haddockHTMLs as URL not path -- and therefore doesn't expand $topdir on Windows - map takeDirectory . haddockInterfaces <$> lookupPackage df ui + map takeDirectory . unitHaddockInterfaces <$> lookupUnit df ui diff --git a/ghcide/src/Development/IDE/Spans/LocalBindings.hs b/ghcide/src/Development/IDE/Spans/LocalBindings.hs index cf23e37040..deb1668cfd 100644 --- a/ghcide/src/Development/IDE/Spans/LocalBindings.hs +++ b/ghcide/src/Development/IDE/Spans/LocalBindings.hs @@ -20,12 +20,13 @@ import qualified Data.Set as S import Development.IDE.GHC.Compat (Name, RefMap, Scope (..), Type, getBindSiteFromContext, getScopeFromContext, identInfo, - identType) + identType, NameEnv, nameEnvElts, + unitNameEnv, isSystemName, + RealSrcSpan, realSrcSpanStart, + realSrcSpanEnd) + import Development.IDE.GHC.Error import Development.IDE.Types.Location -import Name (isSystemName) -import NameEnv -import SrcLoc ------------------------------------------------------------------------------ -- | Turn a 'RealSrcSpan' into an 'Interval'. diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 58603efb1b..cee3024105 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -7,10 +7,11 @@ module Development.IDE.Types.Exports createExportsMap, createExportsMapMg, createExportsMapTc, - buildModuleExportMapFrom -,createExportsMapHieDb,size) where + buildModuleExportMapFrom, + createExportsMapHieDb, + size, + ) where -import Avail (AvailInfo (..)) import Control.DeepSeq (NFData (..)) import Control.Monad import Data.Bifunctor (Bifunctor (second)) @@ -24,12 +25,8 @@ import Data.Text (Text, pack) import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util -import FieldLabel (flSelector) import GHC.Generics (Generic) -import GhcPlugins (IfaceExport, ModGuts (..)) import HieDb -import Name -import TcRnTypes (TcGblEnv (..)) data ExportsMap = ExportsMap @@ -81,8 +78,12 @@ renderIEWrapped n occ = occName n mkIdentInfos :: Text -> AvailInfo -> [IdentInfo] -mkIdentInfos mod (Avail n) = +mkIdentInfos mod (AvailName n) = [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod] +mkIdentInfos mod (AvailFL fl) = + [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod] + where + n = flSelector fl mkIdentInfos mod (AvailTC parent (n:nn) flds) -- Following the GHC convention that parent == n if parent is exported | n == parent diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index bca62f96f4..66c4cc7759 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -26,22 +26,16 @@ import Development.IDE.GHC.Error (catchSrcErrors) import Development.IDE.GHC.Util (lookupPackageConfig) import Development.IDE.Graph.Classes import Development.IDE.Types.Exports (ExportsMap, createExportsMap) -import GhcPlugins (HscEnv (hsc_dflags)) -import LoadIface (loadInterface) -import qualified Maybes --- import Module (InstalledUnitId) import OpenTelemetry.Eventlog (withSpan) import System.Directory (canonicalizePath) import System.FilePath -import TcRnMonad (WhereFrom (ImportByUser), - initIfaceLoad) -- | An 'HscEnv' with equality. Two values are considered equal -- if they are created with the same call to 'newHscEnvEq'. data HscEnvEq = HscEnvEq { envUnique :: !Unique , hscEnv :: !HscEnv - , deps :: [(InstalledUnitId, DynFlags)] + , deps :: [(UnitId, DynFlags)] -- ^ In memory components for this HscEnv -- This is only used at the moment for the import dirs in -- the DynFlags @@ -57,7 +51,7 @@ data HscEnvEq = HscEnvEq } -- | Wrap an 'HscEnv' into an 'HscEnvEq'. -newHscEnvEq :: FilePath -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq +newHscEnvEq :: FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq newHscEnvEq cradlePath hscEnv0 deps = do let relativeToCradle = (takeDirectory cradlePath ) hscEnv = removeImportPaths hscEnv0 @@ -68,7 +62,7 @@ newHscEnvEq cradlePath hscEnv0 deps = do newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps -newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq +newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do let dflags = hsc_dflags hscEnv @@ -78,23 +72,23 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do -- it's very important to delay the package exports computation envPackageExports <- onceAsync $ withSpan "Package Exports" $ \_sp -> do -- compute the package imports - let pkgst = pkgState dflags - depends = explicitPackages pkgst + let pkgst = unitState hscEnv + depends = explicitUnits pkgst targets = [ (pkg, mn) | d <- depends , Just pkg <- [lookupPackageConfig d hscEnv] - , (mn, _) <- exposedModules pkg + , (mn, _) <- unitExposedModules pkg ] doOne (pkg, mn) = do modIface <- liftIO $ initIfaceLoad hscEnv $ loadInterface "" - (mkModule (packageConfigId pkg) mn) + (mkModule (unitInfoId pkg) mn) (ImportByUser NotBoot) return $ case modIface of - Maybes.Failed _r -> Nothing - Maybes.Succeeded mi -> Just mi + Failed _r -> Nothing + Succeeded mi -> Just mi modIfaces <- mapMaybeM doOne targets return $ createExportsMap modIfaces @@ -104,13 +98,13 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do <$> catchSrcErrors dflags "listVisibleModuleNames" - (evaluate . force . Just $ oldListVisibleModuleNames dflags) + (evaluate . force . Just $ listVisibleModuleNames hscEnv) return HscEnvEq{..} -- | Wrap an 'HscEnv' into an 'HscEnvEq'. newHscEnvEqPreserveImportPaths - :: HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq + :: HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing -- | Unwrap the 'HscEnv' with the original import paths. @@ -118,12 +112,12 @@ newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing hscEnvWithImportPaths :: HscEnvEq -> HscEnv hscEnvWithImportPaths HscEnvEq{..} | Just imps <- envImportPaths - = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = Set.toList imps}} + = hscSetFlags (setImportPaths (Set.toList imps) (hsc_dflags hscEnv)) hscEnv | otherwise = hscEnv removeImportPaths :: HscEnv -> HscEnv -removeImportPaths hsc = hsc{hsc_dflags = (hsc_dflags hsc){importPaths = []}} +removeImportPaths hsc = hscSetFlags (setImportPaths [] (hsc_dflags hsc)) hsc instance Show HscEnvEq where show HscEnvEq{envUnique} = "HscEnvEq " ++ show (hashUnique envUnique) diff --git a/ghcide/src/Development/IDE/Types/Location.hs b/ghcide/src/Development/IDE/Types/Location.hs index 7176499ced..24a61d8a27 100644 --- a/ghcide/src/Development/IDE/Types/Location.hs +++ b/ghcide/src/Development/IDE/Types/Location.hs @@ -31,11 +31,17 @@ import Control.Monad import Data.Hashable (Hashable (hash)) import Data.Maybe (fromMaybe) import Data.String + +#if MIN_VERSION_ghc(9,0,0) +import GHC.Data.FastString +import GHC.Types.SrcLoc as GHC +#else import FastString +import SrcLoc as GHC +#endif import Language.LSP.Types (Location (..), Position (..), Range (..)) import qualified Language.LSP.Types as LSP -import SrcLoc as GHC import Text.ParserCombinators.ReadP as ReadP toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index 2968e54abf..7cd2ea7a3a 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -160,10 +160,10 @@ defaultSkipProgress key = case () of -- | The set of options used to locate files belonging to external packages. data IdePkgLocationOptions = IdePkgLocationOptions - { optLocateHieFile :: PackageConfig -> Module -> IO (Maybe FilePath) + { optLocateHieFile :: UnitState -> Module -> IO (Maybe FilePath) -- ^ Locate the HIE file for the given module. The PackageConfig can be -- used to lookup settings like importDirs. - , optLocateSrcFile :: PackageConfig -> Module -> IO (Maybe FilePath) + , optLocateSrcFile :: UnitState -> Module -> IO (Maybe FilePath) -- ^ Locate the source file for the given module. The PackageConfig can be -- used to lookup settings like importDirs. For DAML, we place them in the package DB. -- For cabal this could point somewhere in ~/.cabal/packages. diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index ae3253f6f5..c83d2c6e89 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -41,7 +41,7 @@ import Data.String import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Development.IDE.Graph -import DynFlags (DynFlags) +import GHC (DynFlags) import GHC.Generics import Ide.Plugin.Config import Ide.Plugin.Properties From 5431f6f3deb0b17aef02f3a138607cafe96c270f Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 28 Aug 2021 14:02:19 +0200 Subject: [PATCH 02/22] Update plugins to use GHC API Compat modules --- cabal-ghc901.project | 6 +- cabal-ghc921.project | 28 +- ghcide/ghcide.cabal | 1 + .../session-loader/Development/IDE/Session.hs | 23 +- ghcide/src/Development/IDE/Core/Compile.hs | 40 +- .../src/Development/IDE/Core/Preprocessor.hs | 28 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 1 + ghcide/src/Development/IDE/Core/Rules.hs | 9 +- ghcide/src/Development/IDE/Core/Tracing.hs | 2 + ghcide/src/Development/IDE/Core/UseStale.hs | 5 +- ghcide/src/Development/IDE/GHC/CPP.hs | 10 +- ghcide/src/Development/IDE/GHC/Compat.hs | 90 +-- ghcide/src/Development/IDE/GHC/Compat/CPP.hs | 10 + ghcide/src/Development/IDE/GHC/Compat/Core.hs | 597 ++++++++++++------ ghcide/src/Development/IDE/GHC/Compat/Env.hs | 112 +++- .../src/Development/IDE/GHC/Compat/Iface.hs | 22 +- .../src/Development/IDE/GHC/Compat/Logger.hs | 22 +- .../Development/IDE/GHC/Compat/Outputable.hs | 3 +- .../src/Development/IDE/GHC/Compat/Parser.hs | 56 +- .../src/Development/IDE/GHC/Compat/Plugins.hs | 37 +- .../src/Development/IDE/GHC/Compat/Units.hs | 118 ++-- ghcide/src/Development/IDE/GHC/Compat/Util.hs | 110 ++++ ghcide/src/Development/IDE/GHC/Error.hs | 2 + ghcide/src/Development/IDE/GHC/ExactPrint.hs | 1 + ghcide/src/Development/IDE/GHC/Util.hs | 6 +- ghcide/src/Development/IDE/GHC/Warnings.hs | 1 + .../src/Development/IDE/Import/FindImports.hs | 2 + ghcide/src/Development/IDE/LSP/Outline.hs | 1 + .../src/Development/IDE/Plugin/CodeAction.hs | 2 + .../IDE/Plugin/CodeAction/ExactPrint.hs | 4 +- .../IDE/Plugin/Completions/Logic.hs | 4 +- ghcide/src/Development/IDE/Plugin/Test.hs | 3 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 1 + ghcide/src/Development/IDE/Spans/AtPoint.hs | 4 +- .../Development/IDE/Spans/Documentation.hs | 1 + ghcide/src/Development/IDE/Types/HscEnvEq.hs | 5 +- .../src/Ide/Plugin/Brittany.hs | 7 +- .../src/Ide/Plugin/CallHierarchy/Internal.hs | 1 - .../src/Ide/Plugin/CallHierarchy/Query.hs | 3 +- .../hls-class-plugin/src/Ide/Plugin/Class.hs | 9 +- .../src/Ide/Plugin/Eval/Code.hs | 6 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 99 +-- .../src/Ide/Plugin/Eval/GHC.hs | 20 +- .../src/Ide/Plugin/Eval/Util.hs | 14 +- .../src/Ide/Plugin/ExplicitImports.hs | 20 +- .../src/Ide/Plugin/Fourmolu.hs | 13 +- .../src/Ide/Plugin/HaddockComments.hs | 10 +- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 35 +- .../src/Ide/Plugin/ModuleName.hs | 4 +- .../src/Ide/Plugin/Ormolu.hs | 19 +- .../src/Ide/Plugin/RefineImports.hs | 19 +- .../src/Ide/Plugin/Rename.hs | 2 +- .../src/Ide/Plugin/Retrie.hs | 25 +- .../src/Ide/Plugin/Splice.hs | 57 +- .../src/Ide/Plugin/StylishHaskell.hs | 7 +- .../src/Wingman/AbstractLSP/TacticActions.hs | 4 +- .../src/Wingman/CaseSplit.hs | 1 - .../hls-tactics-plugin/src/Wingman/CodeGen.hs | 9 +- .../src/Wingman/CodeGen/Utils.hs | 10 +- .../hls-tactics-plugin/src/Wingman/Context.hs | 8 +- .../hls-tactics-plugin/src/Wingman/Debug.hs | 5 +- .../src/Wingman/EmptyCase.hs | 7 +- plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 44 +- .../src/Wingman/Judgements.hs | 5 +- .../src/Wingman/Judgements/SYB.hs | 2 +- .../src/Wingman/Judgements/Theta.hs | 12 - .../src/Wingman/KnownStrategies.hs | 2 +- .../src/Wingman/KnownStrategies/QuickCheck.hs | 7 +- .../src/Wingman/LanguageServer.hs | 21 +- .../src/Wingman/LanguageServer/Metaprogram.hs | 7 +- .../Wingman/LanguageServer/TacticProviders.hs | 2 - .../src/Wingman/Machinery.hs | 6 +- .../src/Wingman/Metaprogramming/Lexer.hs | 2 +- .../src/Wingman/Metaprogramming/Parser.hs | 2 +- .../hls-tactics-plugin/src/Wingman/Naming.hs | 7 +- .../hls-tactics-plugin/src/Wingman/Range.hs | 7 +- .../src/Wingman/StaticPlugin.hs | 5 +- .../hls-tactics-plugin/src/Wingman/Tactics.hs | 16 +- .../hls-tactics-plugin/src/Wingman/Types.hs | 23 +- 79 files changed, 1090 insertions(+), 861 deletions(-) create mode 100644 ghcide/src/Development/IDE/GHC/Compat/Util.hs diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 0d2585d979..4310678a43 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -60,10 +60,10 @@ source-repository-package source-repository-package type: git - location: https://github.com/anka-213/dependent-sum - tag: 8cf4c7fbc3bfa2be475a17bb7c94a1e1e9a830b5 + location: https://github.com/fendor/dependent-sum + tag: 5de03c38b0de4945f4e9bce1b026110e69dc8118 subdir: dependent-sum-template --- https://github.com/obsidiansystems/dependent-sum/pull/57 +-- https://github.com/obsidiansystems/dependent-sum/pull/59 -- benchmark dependency source-repository-package diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 1253bb17ab..1941b23274 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -23,7 +23,6 @@ packages: ./plugins/hls-module-name-plugin ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin - ../../../head.hackage/packages/th-extras-0.0.0.4 tests: true @@ -44,18 +43,26 @@ source-repository-package tag: b6245884ae83e00dd2b5261762549b37390179f8 -- https://github.com/lspitzner/czipwith/pull/2 -source-repository-package - type: git - location: https://github.com/alanz/ghc-exactprint - tag: 9f20a4e880b9e81369e0d2024e60ae02c158c57c --- https://github.com/alanz/ghc-exactprint/pull/101 - -- benchmark dependency source-repository-package type: git location: https://github.com/HeinrichApfelmus/operational tag: 16e19aaf34e286f3d27b3988c61040823ec66537 +source-repository-package + type: git + location: https://github.com/anka-213/th-extras + tag: 57a97b4df128eb7b360e8ab9c5759392de8d1659 +-- https://github.com/mokus0/th-extras/pull/8 +-- https://github.com/mokus0/th-extras/issues/7 + +source-repository-package + type: git + location: https://github.com/fendor/dependent-sum + tag: 5de03c38b0de4945f4e9bce1b026110e69dc8118 + subdir: dependent-sum-template +-- https://github.com/obsidiansystems/dependent-sum/pull/59 + -- Head of hie-bios source-repository-package type: git @@ -68,6 +75,13 @@ source-repository-package location: https://github.com/wz1000/HieDb tag: 45c4671db2da8ce5cd11e964573846cfbf3bbec8 +-- GHC 9.2 for ghc-check +source-repository-package + type: git + location: https://github.com/fendor/ghc-check + tag: 224f3901eaa1b32a27e097968afd4a3894efa77e + -- https://github.com/pepeiborra/ghc-check/pull/14/files + write-ghc-environment-files: never index-state: 2021-08-17T02:21:16Z diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 297f5346fd..19cebfb594 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -179,6 +179,7 @@ library Development.IDE.GHC.Compat.Parser Development.IDE.GHC.Compat.Plugins Development.IDE.GHC.Compat.Units + Development.IDE.GHC.Compat.Util Development.IDE.Core.Compile Development.IDE.GHC.Error Development.IDE.GHC.ExactPrint diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index dda605e22e..edc31ed5fe 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -19,7 +19,7 @@ module Development.IDE.Session import Control.Concurrent.Async import Control.Concurrent.Strict -import Control.Exception.Safe +import Control.Exception.Safe as Safe import Control.Monad import Control.Monad.Extra import Control.Monad.IO.Class @@ -42,12 +42,13 @@ import Data.Time.Clock import Data.Version import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake -import qualified Development.IDE.GHC.Compat.Core as GHC +import qualified Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Core hiding (Target, - TargetFile, TargetModule, Var) + TargetFile, TargetModule, + Var) +import qualified Development.IDE.GHC.Compat.Core as GHC +import Development.IDE.GHC.Compat.Env hiding (Logger) import Development.IDE.GHC.Compat.Units (UnitId) -import Development.IDE.GHC.Compat.Env hiding (Logger) -import qualified Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Util import Development.IDE.Graph (Action) import Development.IDE.Session.VersionCheck @@ -170,7 +171,7 @@ runWithDb :: FilePath -> (HieDb -> IndexQueue -> IO ()) -> IO () runWithDb fp k = do -- Delete the database if it has an incompatible schema version withHieDb fp (const $ pure ()) - `catch` \IncompatibleSchemaVersion{} -> removeFile fp + `Safe.catch` \IncompatibleSchemaVersion{} -> removeFile fp withHieDb fp $ \writedb -> do initConn writedb chan <- newTQueueIO @@ -184,9 +185,9 @@ runWithDb fp k = do forever $ do k <- atomically $ readTQueue chan k db - `catch` \e@SQLError{} -> do + `Safe.catch` \e@SQLError{} -> do hPutStrLn stderr $ "SQLite error in worker, ignoring: " ++ show e - `catchAny` \e -> do + `Safe.catchAny` \e -> do hPutStrLn stderr $ "Uncaught error in database worker, ignoring: " ++ show e @@ -479,7 +480,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do ncfp <- toNormalizedFilePath' <$> canonicalizePath file cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap hieYaml <- cradleLoc file - sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `catch` \e -> + sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e -> return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml) returnWithVersion $ \file -> do @@ -730,7 +731,7 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs where tryIO :: IO a -> IO (Either IOException a) - tryIO = try + tryIO = Safe.try do_one :: FilePath -> IO (FilePath, Maybe UTCTime) do_one fp = (fp,) . eitherToMaybe <$> tryIO (getModificationTime fp) @@ -790,8 +791,6 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do -- initPackages parses the -package flags and -- sets up the visibility for each component. -- Throws if a -package flag cannot be satisfied. - -- TODO: this is wrong for ghc 9.2, as the UnitState is stored in UnitEnv in HscEnv, - -- which we lose here env <- hscSetFlags dflags'' <$> getSession final_env' <- liftIO $ wrapPackageSetupException $ Compat.initUnits env return (hsc_dflags final_env', targets) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index e257b07f6c..daab5375c5 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -44,11 +44,13 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Compat hiding (writeHieFile, parseModule, loadInterface, parseHeader) import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat.Util as Util import qualified Development.IDE.GHC.Compat as GHC import HieDb @@ -455,16 +457,16 @@ generateHieAsts hscEnv tcm = -- These varBinds use unitDataConId but it could be anything as the id name is not used -- during the hie file generation process. It's a workaround for the fact that the hie modules -- don't export an interface which allows for additional information to be added to hie files. - let fake_splice_binds = listToBag (map (mkVarBind unitDataConId) (spliceExpresions $ tmrTopLevelSplices tcm)) + let fake_splice_binds = Util.listToBag (map (mkVarBind unitDataConId) (spliceExpresions $ tmrTopLevelSplices tcm)) real_binds = tcg_binds $ tmrTypechecked tcm #if MIN_VERSION_ghc(9,0,1) ts = tmrTypechecked tcm :: TcGblEnv - top_ev_binds = tcg_ev_binds ts :: Bag EvBind + top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind insts = tcg_insts ts :: [ClsInst] tcs = tcg_tcs ts :: [TyCon] - Just <$> GHC.enrichHie (fake_splice_binds `unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs + Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs #else - Just <$> GHC.enrichHie (fake_splice_binds `unionBags` real_binds) (tmrRenamed tcm) + Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) #endif where dflags = hsc_dflags hscEnv @@ -507,7 +509,7 @@ spliceExpresions Splices{..} = -- TVar to 0 in order to set it up for a fresh indexing session. Otherwise, we -- can just increment the 'indexCompleted' TVar and exit. -- -indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Fingerprint -> Compat.HieFile -> IO () +indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Util.Fingerprint -> Compat.HieFile -> IO () indexHieFile se mod_summary srcPath !hash hf = do IdeOptions{optProgressStyle} <- getIdeOptionsIO se atomically $ do @@ -614,7 +616,7 @@ writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source = hf <- runHsc hscEnv $ GHC.mkHieFile' mod_summary exports ast source atomicFileWrite targetPath $ flip GHC.writeHieFile hf - hash <- getFileHash targetPath + hash <- Util.getFileHash targetPath indexHieFile se mod_summary srcPath hash hf where dflags = hsc_dflags hscEnv @@ -698,7 +700,7 @@ getModSummaryFromImports :: HscEnv -> FilePath -> UTCTime - -> Maybe StringBuffer + -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult getModSummaryFromImports env fp modTime contents = do (contents, opts, dflags) <- preprocessor env fp contents @@ -710,7 +712,7 @@ getModSummaryFromImports env fp modTime contents = do let mb_mod = hsmodName hsmod imps = hsmodImports hsmod - mod = fmap unLoc mb_mod `orElse` mAIN_NAME + mod = fmap unLoc mb_mod `Util.orElse` mAIN_NAME (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource.unLoc) imps @@ -765,14 +767,14 @@ getModSummaryFromImports env fp modTime contents = do -- eliding the timestamps, the preprocessed source and other non relevant fields computeFingerprint opts ModSummary{..} = do fingerPrintImports <- fingerprintFromPut $ do - put $ uniq $ moduleNameFS $ moduleName ms_mod + put $ Util.uniq $ moduleNameFS $ moduleName ms_mod forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do - put $ uniq $ moduleNameFS $ unLoc m - whenJust mb_p $ put . uniq - return $! fingerprintFingerprints $ - [ fingerprintString fp + put $ Util.uniq $ moduleNameFS $ unLoc m + whenJust mb_p $ put . Util.uniq + return $! Util.fingerprintFingerprints $ + [ Util.fingerprintString fp , fingerPrintImports - ] ++ map fingerprintString opts + ] ++ map Util.fingerprintString opts -- | Parse only the module header @@ -780,14 +782,14 @@ parseHeader :: Monad m => DynFlags -- ^ flags to use -> FilePath -- ^ the filename (for source locations) - -> StringBuffer -- ^ Haskell module source text (full Unicode is supported) + -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported) #if MIN_VERSION_ghc(9,0,1) -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule)) #else -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs)) #endif parseHeader dflags filename contents = do - let loc = mkRealSrcLoc (mkFastString filename) 1 1 + let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of #if MIN_VERSION_ghc(8,10,0) PFailed pst -> @@ -823,7 +825,7 @@ parseFileContents -> ModSummary -> ExceptT [FileDiagnostic] IO ([FileDiagnostic], ParsedModule) parseFileContents env customPreprocessor filename ms = do - let loc = mkRealSrcLoc (mkFastString filename) 1 1 + let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 dflags = ms_hspp_opts ms contents = fromJust $ ms_hspp_buf ms case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of @@ -875,7 +877,7 @@ parseFileContents env customPreprocessor filename ms = do $ filter (/= n_hspp) $ map normalise $ filter (not . isPrefixOf "<") - $ map unpackFS + $ map Util.unpackFS $ srcfiles pst srcs1 = case ml_hs_file (ms_location ms) of Just f -> filter (/= normalise f) srcs0 @@ -980,7 +982,7 @@ getDocsBatch hsc_env _mod _names = do UnhelpfulLoc {} -> True fakeSpan :: RealSrcSpan -fakeSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "") 1 1 +fakeSpan = realSrcLocSpan $ mkRealSrcLoc (Util.fsLit "") 1 1 -- | Non-interactive, batch version of 'InteractiveEval.lookupNames'. -- The interactive paths create problems in ghc-lib builds diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 4a113e19fe..938879d062 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -7,6 +7,8 @@ module Development.IDE.Core.Preprocessor import Development.IDE.GHC.CPP import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Orphans () import Control.DeepSeq (NFData (rnf)) @@ -30,7 +32,7 @@ import System.IO.Extra -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. -preprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> ExceptT [FileDiagnostic] IO (StringBuffer, [String], DynFlags) +preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], DynFlags) preprocessor env0 filename mbContents = do -- Perform unlit (isOnDisk, contents) <- @@ -38,7 +40,7 @@ preprocessor env0 filename mbContents = do newcontent <- liftIO $ runLhs env0 filename mbContents return (False, newcontent) else do - contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents + contents <- liftIO $ maybe (Util.hGetStringBuffer filename) return mbContents let isOnDisk = isNothing mbContents return (isOnDisk, contents) @@ -56,7 +58,7 @@ preprocessor env0 filename mbContents = do $ (Right <$> (runCpp (putLogHook newLogger env1) filename $ if isOnDisk then Nothing else Just contents)) `catch` - ( \(e :: GhcException) -> do + ( \(e :: Util.GhcException) -> do logs <- readIORef cppLogs case diagsFromCPPLogs filename (reverse logs) of [] -> throw e @@ -129,7 +131,7 @@ isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"] parsePragmasIntoDynFlags :: HscEnv -> FilePath - -> StringBuffer + -> Util.StringBuffer -> IO (Either [FileDiagnostic] ([String], DynFlags)) parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do let opts = getOptions dflags0 contents fp @@ -143,7 +145,7 @@ parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do where dflags0 = hsc_dflags env -- | Run (unlit) literate haskell preprocessor on a file, or buffer if set -runLhs :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer +runLhs :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer runLhs env filename contents = withTempDir $ \dir -> do let fout = dir takeFileName filename <.> "unlit" filesrc <- case contents of @@ -154,7 +156,7 @@ runLhs env filename contents = withTempDir $ \dir -> do hPutStringBuffer h cnts return fsrc unlit filesrc fout - hGetStringBuffer fout + Util.hGetStringBuffer fout where logger = hsc_logger env dflags = hsc_dflags env @@ -173,10 +175,10 @@ runLhs env filename contents = withTempDir $ \dir -> do escape [] = [] -- | Run CPP on a file -runCpp :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer +runCpp :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer runCpp env0 filename contents = withTempDir $ \dir -> do let out = dir takeFileName filename <.> "out" - dflags1 <- pure $ addOptP "-D__GHCIDE__" (hsc_dflags env0) + let dflags1 = addOptP "-D__GHCIDE__" (hsc_dflags env0) let env1 = hscSetFlags dflags1 env0 case contents of @@ -185,14 +187,14 @@ runCpp env0 filename contents = withTempDir $ \dir -> do -- which also makes things like relative #include files work -- and means location information is correct doCpp env1 True filename out - liftIO $ hGetStringBuffer out + liftIO $ Util.hGetStringBuffer out Just contents -> do -- Sad path, we have to create a version of the path in a temp dir -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue) -- Relative includes aren't going to work, so we fix that by adding to the include path. - dflags2 <- return $ addIncludePathsQuote (takeDirectory filename) dflags1 + let dflags2 = addIncludePathsQuote (takeDirectory filename) dflags1 let env2 = hscSetFlags dflags2 env0 -- Location information is wrong, so we fix that by patching it afterwards. let inp = dir "___GHCIDE_MAGIC___" @@ -210,11 +212,11 @@ runCpp env0 filename contents = withTempDir $ \dir -> do -- and GHC gets all confused = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\"" | otherwise = x - stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out + Util.stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out -- | Run a preprocessor on a file -runPreprocessor :: HscEnv -> FilePath -> Maybe StringBuffer -> IO StringBuffer +runPreprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer runPreprocessor env filename contents = withTempDir $ \dir -> do let out = dir takeFileName filename <.> "out" inp <- case contents of @@ -225,7 +227,7 @@ runPreprocessor env filename contents = withTempDir $ \dir -> do hPutStringBuffer h contents return inp runPp logger dflags [Option filename, Option inp, FileOption "" out] - hGetStringBuffer out + Util.hGetStringBuffer out where logger = hsc_logger env dflags = hsc_dflags env diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 1f73f200d8..abbc7c6cf3 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -25,6 +25,7 @@ import Data.Time.Clock.POSIX import Data.Typeable import Development.IDE.GHC.Compat hiding (HieFileResult) +import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Util import Development.IDE.Graph import Development.IDE.Import.DependencyInformation diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 06b4a9e5db..a964b82a78 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -110,6 +110,7 @@ import Development.IDE.GHC.Compat.Core hiding loadInterface, Var) import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util hiding @@ -498,8 +499,8 @@ getDependenciesRule = let allFiles = reachableModules depInfo _ <- uses_ ReportImportCycles allFiles opts <- getIdeOptions - let mbFingerprints = map (fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts - return (fingerprintToBS . fingerprintFingerprints <$> mbFingerprints, transitiveDeps depInfo file) + let mbFingerprints = map (Util.fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts + return (fingerprintToBS . Util.fingerprintFingerprints <$> mbFingerprints, transitiveDeps depInfo file) getHieAstsRule :: Rules () getHieAstsRule = @@ -750,7 +751,7 @@ getModIfaceFromDiskAndIndexRule = -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db let ms = hirModSummary x hie_loc = Compat.ml_hie_file $ ms_location ms - hash <- liftIO $ getFileHash hie_loc + hash <- liftIO $ Util.getFileHash hie_loc mrow <- liftIO $ HieDb.lookupHieFileFromSource hiedb (fromNormalizedFilePath f) hie_loc' <- liftIO $ traverse (canonicalizePath . HieDb.hieModuleHieFile) mrow case mrow of @@ -815,7 +816,7 @@ getModSummaryRule = do Right res -> do bufFingerPrint <- liftIO $ fingerprintFromStringBuffer $ fromJust $ ms_hspp_buf $ msrModSummary res - let fingerPrint = fingerprintFingerprints + let fingerPrint = Util.fingerprintFingerprints [ msrFingerprint res, bufFingerPrint ] return ( Just (fingerprintToBS fingerPrint) , ([], Just res)) Left diags -> return (Nothing, (diags, Nothing)) diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 1c773587bc..546b2eae44 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -21,7 +21,9 @@ import Control.Monad (forM_, forever, unless, void, import Control.Monad.Extra (whenJust) import Control.Monad.IO.Unlift import Control.Seq (r0, seqList, seqTuple2, using) +#if MIN_VERSION_ghc(8,8,0) import Data.ByteString (ByteString) +#endif import Data.Dynamic (Dynamic) import qualified Data.HashMap.Strict as HMap import Data.IORef (modifyIORef', newIORef, diff --git a/ghcide/src/Development/IDE/Core/UseStale.hs b/ghcide/src/Development/IDE/Core/UseStale.hs index c27fd0fd6f..55b52e39be 100644 --- a/ghcide/src/Development/IDE/Core/UseStale.hs +++ b/ghcide/src/Development/IDE/Core/UseStale.hs @@ -30,9 +30,8 @@ import Data.Functor.Identity (Identity (Identity)) import Data.Kind (Type) import Data.String (fromString) import Development.IDE.GHC.Compat (RealSrcSpan, - srcSpanFile, - - unpackFS) + srcSpanFile) +import Development.IDE.GHC.Compat.Util (unpackFS) import Development.IDE (Action, IdeRule, NormalizedFilePath, Range, diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 9248cbfe29..307fdea237 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -1,12 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 --- Copied from https://github.com/ghc/ghc/blob/master/compiler/main/DriverPipeline.hs on 14 May 2019 --- Requested to be exposed at https://gitlab.haskell.org/ghc/ghc/merge_requests/944. --- Update the above MR got merged to master on 31 May 2019. When it becomes avialable to ghc-lib, this file can be removed. - -{- HLINT ignore -} -- since copied from upstream - {-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} @@ -28,13 +22,13 @@ import GHC import Development.IDE.GHC.Compat as Compat #if !MIN_VERSION_ghc(8,10,0) import qualified Development.IDE.GHC.Compat.CPP as CPP +#else +import Development.IDE.GHC.Compat.Util #endif #if MIN_VERSION_ghc(9,0,0) import qualified GHC.Driver.Pipeline as Pipeline -import GHC.SysTools as SysTools import GHC.Settings -import GHC.Utils.Fingerprint #else #if MIN_VERSION_ghc (8,10,0) import qualified DriverPipeline as Pipeline diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 96b7390f58..861a7e0905 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -5,7 +5,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} -{-# OPTIONS -Wno-incomplete-uni-patterns #-} +{-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-} -- | Attempt at hiding the GHC version differences we can. module Development.IDE.GHC.Compat( @@ -34,9 +34,6 @@ module Development.IDE.GHC.Compat( #if !MIN_VERSION_ghc(9,0,1) RefMap, #endif - -- Linear - Scaled, - scaledThing, #if MIN_VERSION_ghc(9,0,0) IsBootInterface(..), @@ -47,8 +44,6 @@ module Development.IDE.GHC.Compat( nodeInfo', getNodeIds, - stringToUnit, - unitString, pprSigmaType, @@ -74,7 +69,6 @@ module Development.IDE.GHC.Compat( module Development.IDE.GHC.Compat.Env, module Development.IDE.GHC.Compat.Iface, module Development.IDE.GHC.Compat.Logger, - module Development.IDE.GHC.Compat.Outputable, module Development.IDE.GHC.Compat.Parser, module Development.IDE.GHC.Compat.Plugins, module Development.IDE.GHC.Compat.Units, @@ -93,62 +87,31 @@ import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface import Development.IDE.GHC.Compat.Logger -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Compat.Parser import Development.IDE.GHC.Compat.Plugins import Development.IDE.GHC.Compat.Units +import Development.IDE.GHC.Compat.Util #if MIN_VERSION_ghc(9,0,0) -import GHC.Core.DataCon (dataConWrapId) -import GHC.Core.ConLike (ConLike(..)) -import GHC.Core.Multiplicity -import qualified GHC.Core.TyCo.Rep as TyCoRep -import GHC.Data.StringBuffer -import GHC.Data.FastString -import GHC.Data.Bag -import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags +import GHC.Data.StringBuffer +import GHC.Driver.Session hiding (ExposePackage) #if !MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Types +import GHC.Driver.Types #endif -import GHC.Hs.Extension -import qualified GHC.Hs.Type as GHC -import GHC.Iface.Load -import GHC.Iface.Make (mkIfaceExports) -import GHC.Unit.Info (PackageName) -import qualified GHC.Unit.Info as Packages +import GHC.Hs.Extension +import GHC.Iface.Make (mkIfaceExports) +import qualified GHC.SysTools.Tasks as SysTools +import GHC.Tc.Utils.TcType (pprSigmaType) +import qualified GHC.Types.Avail as Avail import qualified GHC.Unit.Module.Location as Module -import GHC.Unit.Module.Name (moduleNameSlashes) -import GHC.Unit.State (ModuleOrigin(..)) -import qualified GHC.Unit.State as Packages -import qualified GHC.Unit.Types as Module -import GHC.Unit.Types (unitString, IsBootInterface(..)) -import GHC.Utils.Fingerprint -import GHC.Utils.Panic -import qualified GHC.SysTools.Tasks as SysTools -import GHC.Tc.Types (TcGblEnv(..)) -import GHC.Tc.Utils.TcType (pprSigmaType) -import qualified GHC.Types.Avail as Avail -import GHC.Types.FieldLabel -import GHC.Types.Name -import GHC.Types.Name.Occurrence -import GHC.Types.Name.Cache -import GHC.Types.Name.Env -import GHC.Types.Name.Reader (rdrNameOcc) -import GHC.Types.SrcLoc (BufSpan) -import qualified GHC.Types.SrcLoc as SrcLoc -import GHC.Types.Var -import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) #else import DynFlags hiding (ExposePackage) import qualified Module #if MIN_VERSION_ghc(9,0,0) import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) import GHC.Core.TyCo.Ppr (pprSigmaType) -import GHC.Core.TyCo.Rep (Scaled, scaledThing) import GHC.Iface.Load import GHC.Types.Unique.Set (emptyUniqSet) -import Module (unitString) #else import TcType (pprSigmaType) #endif @@ -313,34 +276,10 @@ getModuleHash = mi_mod_hash . mi_final_exts getModuleHash = mi_mod_hash #endif -#if MIN_VERSION_ghc(9,2,0) - -packageName = Packages.unitPackageName -moduleUnitId = Module.moduleUnit -thisInstalledUnitId = GHC.homeUnitId_ -thisPackage = GHC.homeUnitId_ - -#elif MIN_VERSION_ghc(9,0,0) -packageName = Packages.unitPackageName -getPackageIncludePath = Packages.getUnitIncludePath -moduleUnitId = Module.moduleUnit --- initUnits = Packages.initUnits --- initPackages = initPackagesx - -thisInstalledUnitId = GHC.homeUnitId -thisPackage = DynFlags.homeUnit -#else - - +#if !MIN_VERSION_ghc(9,0,0) pattern NotBoot, IsBoot :: IsBootInterface pattern NotBoot = False pattern IsBoot = True - - --- Linear Haskell -type Scaled a = a -scaledThing :: Scaled a -> a -scaledThing = id #endif @@ -369,6 +308,8 @@ isQualifiedImport _ = False getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a) getNodeIds = Map.foldl' combineNodeIds Map.empty . getSourcedNodeInfo . sourcedNodeInfo +combineNodeIds :: Map.Map Identifier (IdentifierDetails a) + -> NodeInfo a -> Map.Map Identifier (IdentifierDetails a) ad `combineNodeIds` (NodeInfo _ _ bd) = Map.unionWith (<>) ad bd -- Copied from GHC and adjusted to accept TypeIndex instead of Type @@ -388,7 +329,6 @@ combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a mergeSorted as [] = as mergeSorted [] bs = bs -stringToUnit = Module.stringToUnit #else getNodeIds :: HieAST a -> NodeIdentifiers a @@ -399,10 +339,6 @@ getNodeIds = nodeIdentifiers . nodeInfo nodeInfo' :: Ord a => HieAST a -> NodeInfo a nodeInfo' = nodeInfo -- type Unit = UnitId -unitString :: Unit -> String -unitString = Module.unitIdString -stringToUnit :: String -> Unit -stringToUnit = Module.stringToUnitId -- moduleUnit :: Module -> Unit -- moduleUnit = moduleUnitId -- unhelpfulSpanFS :: FS.FastString -> FS.FastString diff --git a/ghcide/src/Development/IDE/GHC/Compat/CPP.hs b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs index 69fe1b7538..855e66e5ff 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/CPP.hs @@ -1,4 +1,14 @@ +-- Copyright (c) 2019 The DAML Authors. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- Copied from https://github.com/ghc/ghc/blob/master/compiler/main/DriverPipeline.hs on 14 May 2019 +-- Requested to be exposed at https://gitlab.haskell.org/ghc/ghc/merge_requests/944. +-- Update the above MR got merged to master on 31 May 2019. When it becomes avialable to ghc-lib, this file can be removed. + +{- HLINT ignore -} -- since copied from upstream + {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Re-export 'doCpp' for GHC < 8.10. -- -- Later versions export what we need. diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index f324123e7b..eaab329483 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -2,7 +2,8 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} --- {-# OPTIONS -Wno-dodgy-imports #-} +-- TODO: remove +{-# OPTIONS -Wno-dodgy-imports #-} -- | Compat Core module that handles the GHC module hierarchy re-organisation -- by re-exporting everything we care about. @@ -10,65 +11,86 @@ -- This module provides no other compat mechanisms, except for simple -- backward-compatible pattern synonyms. module Development.IDE.GHC.Compat.Core ( - -- * Exception handling - GhcException, - handleGhcException, - gcatch, - -- * Bags - Bag, - bagToList, - listToBag, - unionBags, - isEmptyBag, - -- * UniqueSupply - mkSplitUniqSupply, - -- * Maybes - MaybeErr(..), - orElse, -#if MIN_VERSION_ghc(8,10,0) - -- * Pair - Pair(..), -#endif -- * Session DynFlags, + extensions, + extensionFlags, + targetPlatform, packageFlags, + generalFlags, + warningFlags, + topDir, hiDir, tmpDir, importPaths, + useColor, + canUseColor, useUnicode, objectDir, flagsForCompletion, setImportPaths, outputFile, + pluginModNames, + refLevelHoleFits, + maxRefHoleFits, + maxValidHoleFits, +#if MIN_VERSION_ghc(8,8,0) + CommandLineOption, + StaticPlugin(..), + staticPlugins, +#endif + sPgm_F, + settings, gopt, gopt_set, gopt_unset, wopt, wopt_set, + xFlags, xopt, + xopt_unset, xopt_set, + FlagSpec(..), WarningFlag(..), GeneralFlag(..), PackageFlag, + PackageArg(..), + ModRenaming(..), pattern ExposePackage, + parseDynamicFlagsCmdLine, parseDynamicFilePragma, WarnReason(..), wWarningFlags, - flagSpecName, - flagSpecFlag, updOptLevel, -- slightly unsafe setUnsafeGlobalDynFlags, + -- * Linear Haskell + Scaled, + scaledThing, + -- * UniqueSupply + UniqSupply, + takeUniqFromSupply, + mkSplitUniqSupply, -- * ConLike ConLike(..), conLikeName, conLikeFieldLabels, + conLikeFieldType, + conLikeIsInfix, + conLikeInstOrigArgTys, + conLikeResTy, + DataCon, + dataConFieldLabels, + dataConName, dataConWrapId, - -- * Fingerprint - Fingerprint(..), - getFileHash, - fingerprintData, - fingerprintFingerprints, + nilDataCon, + dataConCannotMatch, + isDataConName, + isTupleDataCon, + tupleDataCon, + consDataCon, + dataConIsInfix, + dataConInstSig, -- * Interface Files IfaceExport, IfaceTyCon(..), @@ -92,6 +114,8 @@ module Development.IDE.GHC.Compat.Core ( mkIface, #endif checkOldIface, + -- * Fixity + LexicalFixity(..), -- * ModSummary ModSummary(..), -- * HomeModInfo @@ -113,7 +137,14 @@ module Development.IDE.GHC.Compat.Core ( lookupNameEnv, -- * NameSpace isTcClsNameSpace, + -- * InstEnvs + InstEnvs(..), + lookupInstEnv, + -- * FamInstEnvs + FamInstEnvs, + normaliseType, -- * Var + Id, Type ( TyCoRep.TyVarTy, TyCoRep.AppTy, @@ -132,6 +163,11 @@ module Development.IDE.GHC.Compat.Core ( isForAllTy, isFunTy, isPiTy, + isBoolTy, + isFloatingTy, + isIntTy, + isIntegerTy, + isStringTy, #if MIN_VERSION_ghc(8,10,0) coercionKind, isCoercionTy_maybe, @@ -139,18 +175,80 @@ module Development.IDE.GHC.Compat.Core ( isCoercionTy, splitCoercionType_maybe, #endif + substTyAddInScope, + piResultTys, + splitAppTys, splitFunTys, + splitFunTy_maybe, splitPiTys, splitForAllTys, + splitTyConApp_maybe, + TCvSubst, + extendTCvSubst, + emptyTCvSubst, + nonDetCmpType, + substTy, + unionTCvSubst, + zipTvSubst, TyThing(..), binderVar, + pprTyThingInContext, + pprTypeForUser, + TyVar, + setTyVarUnique, + getTyVar_maybe, Var, varType, varName, mkVarOcc, + setVarUnique, + Development.IDE.GHC.Compat.Core.mkVisFunTys, + mkAppTys, + mkTyVarTy, + mkTyConTy, + Development.IDE.GHC.Compat.Core.mkInfForAllTys, + charTy, + eqType, + tcView, + exprType, + isAlgType, + -- * Wired in types + unitDataConId, + charTyCon, + doubleTyCon, + floatTyCon, + intTyCon, + funTyCon, + alphaTy, + alphaTys, + alphaTyVar, + betaTy, + betaTyVar, + listTyCon, + maybeTyCon, + unitTyCon, + -- * TyCoVar + TyCoVar, + tyCoVarsOfTypeList, + tyCoVarsOfTypeWellScoped, + Development.IDE.GHC.Compat.Core.dataConExTyCoVars, + dataConOrigTyCon, + dataConInstArgTys, -- * TyCon TyCon, tyConName, + tyConDataCons, + tyConClass_maybe, + eqPrimTyCon, +#if MIN_VERSION_ghc(8,8,0) + eqTyCon, +#endif + isTupleTyCon, + -- * Class + Class(..), + classMinimalDef, + classMethods, + classSCTheta, -- * Id idName, idType, @@ -160,10 +258,19 @@ module Development.IDE.GHC.Compat.Core ( lookupGlobalRdrEnv, globalRdrEnvElts, lookupGRE_Name, + -- * OccEnv + OccEnv, + emptyOccEnv, + lookupOccEnv, -- * Specs ImpDeclSpec(..), ImportSpec(..), + -- * SourceText + SourceText(..), -- * Name +#if !MIN_VERSION_ghc(9,0,0) + NameOrRdrName, +#endif Name, isValName, isSystemName, @@ -171,11 +278,16 @@ module Development.IDE.GHC.Compat.Core ( nameSrcSpan, nameSrcLoc, nameRdrName, + nameModule, nameModule_maybe, + isQual, + isQual_maybe, getSrcSpan, RdrName(..), mkRdrUnqual, rdrNameFieldOcc, + HasOccName, + getOccName, OccName(..), occName, nameOccName, @@ -187,43 +299,51 @@ module Development.IDE.GHC.Compat.Core ( isSymOcc, isTcOcc, occNameString, - isDataConName, + mkClsOcc, mkVarOccFS, pprNameDefnLoc, Parent(..), + tyThingParent_maybe, + -- * Field Occs + FieldOcc, + mkFieldOcc, + -- * Ways + Way, + wayGeneralFlags, + wayUnsetGeneralFlags, -- * AvailInfo Avail.AvailInfo, pattern AvailName, pattern AvailFL, pattern AvailTC, + Avail.availName, + Avail.availNames, + Avail.availNamesWithSelectors, -- * NameSet + NameSet, + FreeVars, elemNameSet, + mkNameSet, Avail.availsToNameSet, -- * TcGblEnv TcGblEnv(..), + -- * Renamer stage + RnM, + rnTopSpliceDecls, + rnSplicePat, + rnSpliceType, + rnSpliceExpr, + -- * Rename Stage Names + findImportUsage, + getMinimalImports, -- * FieldLabel FieldLabel, flSelector, flLabel, - -- * FastString exports - FastString, -#if MIN_VERSION_ghc(9,2,0) - -- Export here, so we can coerce safely on consumer sites - LexicalFastString(..), -#endif - uniq, - unpackFS, - fingerprintString, - mkFastString, - fsLit, -- * Header Parser getOptions, -- * ErrUtils Severity(..), - -- * String Buffer - StringBuffer(..), - hGetStringBuffer, - stringToStringBuffer, -- * Parsing and Expr types P(..), PState(..), @@ -239,29 +359,35 @@ module Development.IDE.GHC.Compat.Core ( HsModule(..), LHsContext, HsContext, + HsMatchContext(..), LHsExpr, HsExpr(..), + isAtomicHsExpr, LIE, IE(..), + ieName, ieNames, IEWrappedName(..), IEWildcard(..), - Pat(..), LPat, + Pat(..), + ListPatTc(..), LHsDecl, HsDecl(..), TyClDecl(..), + TyClGroup(..), HsDataDefn(..), ConDecl(..), InstDecl(..), -#if MIN_VERSION_ghc(9,0,0) ClsInst, -#endif + is_dfun, ClsInstDecl(..), DataFamInstDecl(..), TyFamInstDecl(..), FamEqn(..), DerivDecl(..), + LRuleDecls, + RuleDecl(..), LSig, Sig(..), DefaultDecl(..), @@ -274,23 +400,35 @@ module Development.IDE.GHC.Compat.Core ( RoleAnnotDecl(..), FamilyDecl(..), HsConDetails(..), + HsConDeclDetails, + LHsBinds, LHsBind, HsBind, + ABExport(..), + LHsBindLR, HsBindLR(..), PatSynBind(..), + HsGroup(..), MatchGroup(..), + HsSplice(..), + LHsSigType, LHsType, HsType(..), + HsRecField, + HsRecField'(..), + HsRecFields(..), LImportDecl, ImportDecl(..), #if MIN_VERSION_ghc(8,10,0) ImportDeclQualifiedStyle(..), #endif + HsWrapper(..), HsWildCardBndrs(..), HsImplicitBndrs(..), LConDeclField, ConDeclField(..), HsValBindsLR(..), + NHsValBindsLR(..), LMatch, Match(..), StmtLR(..), @@ -298,6 +436,9 @@ module Development.IDE.GHC.Compat.Core ( GRHSs(..), HsLocalBinds, HsLocalBindsLR(..), +#if !MIN_VERSION_ghc(9,0,0) + UnboundVar(..), +#endif parseHeader, parseIdentifier, parseModule, @@ -317,6 +458,7 @@ module Development.IDE.GHC.Compat.Core ( patSynMatcher, patSynName, patSynSig, + patSynExTyVars, pprPatSynType, -- * API Annotations AnnKeywordId(..), @@ -329,7 +471,9 @@ module Development.IDE.GHC.Compat.Core ( modifySession, getSession, setSessionDynFlags, + getSessionDynFlags, GhcMonad, + Ghc, runHsc, compileFile, Phase(..), @@ -344,7 +488,19 @@ module Development.IDE.GHC.Compat.Core ( initTc, initTcWithGbl, tcLookup, + tcLookupDataFamInst_maybe, + tcSplitAppTys, + tcSplitPhiTy, + tcSplitTyConApp, + tcSplitTyConApp_maybe, + tcSplitFunTys, + tcSplitNestedSigmaTys, + tcSplitForAllTys, + tcSplitForAllTy_maybe, + tcSplitSigmaTy, TcTyThing(..), + tcTyConAppTyCon_maybe, + tcVisibleOrphanMods, tcRnImportDecls, typecheckIface, mkIfaceTc, @@ -353,6 +509,7 @@ module Development.IDE.GHC.Compat.Core ( ImportedModsVal(..), importedByUser, collectHsBindsBinders, + TypecheckedSource, -- * Source Locations HasSrcSpan, Located, @@ -363,8 +520,10 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan), SrcLoc.RealSrcSpan, pattern RealSrcSpan, + SrcLoc.RealSrcLoc, SrcLoc.SrcLoc(..), BufSpan, + SrcLoc.containsSpan, SrcLoc.mkGeneralSrcSpan, SrcLoc.mkRealSrcSpan, SrcLoc.mkRealSrcLoc, @@ -376,16 +535,25 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.wiredInSrcSpan, SrcLoc.mkSrcSpan, SrcLoc.srcSpanStart, + SrcLoc.srcSpanStartLine, + SrcLoc.srcSpanStartCol, SrcLoc.srcSpanEnd, + SrcLoc.srcSpanEndLine, + SrcLoc.srcSpanEndCol, SrcLoc.srcSpanFile, SrcLoc.srcLocCol, + SrcLoc.srcLocFile, SrcLoc.srcLocLine, + SrcLoc.noSrcSpan, + SrcLoc.noSrcLoc, + SrcLoc.noLoc, #if !MIN_VERSION_ghc(8,10,0) && MIN_VERSION_ghc(8,8,0) SrcLoc.dL, #endif -- * Finder FindResult(..), mkHomeModLocation, + addBootSuffixLocnOut, findObjectLinkableMaybe, InstalledFindResult(..), -- * Module and Package @@ -431,13 +599,11 @@ module Development.IDE.GHC.Compat.Core ( mkBootModDetailsTc, tidyProgram, -- * PrelInfo + pRELUDE, mkPrelImports, knownKeyNames, - -- * Wired-in - unitDataConId, -- * Utils with no home, neither here nor in GHC mkVarBind, - addBootSuffixLocnOut, -- * HPT addToHpt, addListToHpt, @@ -448,195 +614,224 @@ module Development.IDE.GHC.Compat.Core ( -- * GHCi initObjLinker, loadDLL, + InteractiveImport(..), + getContext, + setContext, + parseImportDecl, + runDecls, + Warn(..), + -- * Desugared + dsExpr, + initDs, + -- * PredType + PredType, + ThetaType, + -- * Role + Role(..), + -- * Module extraction + extractModule, + -- * Ppr utils + showToHeader, + pprDefinedAt, + pprInfixName, -- * Panic panic, ) where -import GHC hiding (HasSrcSpan, ModLocation, getLoc, - lookupName, RealSrcSpan, moduleUnitId, parseModule, - Phase) +import GHC hiding (HasSrcSpan, ModLocation, + Phase, RealSrcSpan, exprType, + getLoc, lookupName, moduleUnitId, + parseModule) #if MIN_VERSION_ghc(9,0,0) import qualified GHC -import GHC.Builtin.Utils -import GHC.Builtin.Types -import GHC.Core.DataCon (dataConWrapId) -import GHC.Core.Coercion -import GHC.Core.ConLike (ConLike(..), conLikeName, conLikeFieldLabels) -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Core.PatSyn -#endif -import qualified GHC.Core.TyCo.Rep as TyCoRep -import GHC.Core.TyCon -import GHC.Core.Type -import GHC.Core.Predicate -import GHC.Data.Bag -import GHC.Data.FastString -import GHC.Data.Maybe -import GHC.Data.StringBuffer -import GHC.Data.Pair +import GHC.Builtin.Names +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim +import GHC.Builtin.Utils +import GHC.Core.Class +import GHC.Core.Coercion +import GHC.Core.ConLike +import GHC.Core.DataCon as DataCon +import GHC.Core.FamInstEnv +import GHC.Core.InstEnv #if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env -import GHC.Driver.Env.Types +import GHC.Core.Multiplicity (Scaled, scaledThing) #else -import GHC.Driver.Types -import GHC.Driver.Finder -#endif -import GHC.Driver.Main -import GHC.Driver.Hooks -import GHC.Driver.Monad -import GHC.Driver.Pipeline -import GHC.Driver.Phases -import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags +import GHC.Core.PatSyn +import GHC.Core.TyCo.Rep (scaledThing) +#endif +import GHC.Core.Ppr.TyThing +import GHC.Core.Predicate +import qualified GHC.Core.TyCo.Rep as TyCoRep +import GHC.Core.TyCon +import GHC.Core.Type as TcType +import GHC.Core.Utils + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Env +import GHC.Driver.Env.Types +#else +import GHC.Driver.Finder +import GHC.Driver.Types +import GHC.Driver.Ways +#endif +import GHC.Driver.CmdLine (Warn (..)) +import GHC.Driver.Hooks +import GHC.Driver.Main +import GHC.Driver.Monad +import GHC.Driver.Phases +import GHC.Driver.Pipeline +import GHC.Driver.Plugins +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags #if !MIN_VERSION_ghc(9,2,0) -import GHC.HsToCore.Docs -#endif -import GHC.Iface.Load -import GHC.Iface.Make (mkIfaceExports, mkPartialIface, mkIfaceTc, mkFullIface) -import GHC.Iface.Tidy -import GHC.Iface.Type -import GHC.Iface.Recomp -import GHC.IfaceToCore -import GHC.Parser -import GHC.Parser.Header +import GHC.HsToCore.Docs +import GHC.HsToCore.Expr +import GHC.HsToCore.Monad +#endif +import GHC.Iface.Load +import GHC.Iface.Make (mkFullIface, mkIfaceTc, + mkPartialIface) +import GHC.Iface.Recomp +import GHC.Iface.Syntax +import GHC.Iface.Tidy +import GHC.IfaceToCore +import GHC.Parser +import GHC.Parser.Header #if MIN_VERSION_ghc(9,2,0) -import GHC.Linker.Loader -import GHC.Linker.Types +import GHC.Linker.Loader +import GHC.Linker.Types +import GHC.Platform.Ways #else -import GHC.Parser.Lexer -import GHC.Runtime.Interpreter -import GHC.Runtime.Linker -#endif -import GHC.Tc.Module -import GHC.Tc.Types -import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Monad -import qualified GHC.Types.Avail as Avail -import GHC.Types.FieldLabel +import GHC.Parser.Lexer +import GHC.Runtime.Interpreter +import GHC.Runtime.Linker +#endif +import GHC.Rename.Names +import GHC.Rename.Splice +import GHC.Tc.Instance.Family +import GHC.Tc.Module +import GHC.Tc.Types +import GHC.Tc.Types.Evidence +import GHC.Tc.Utils.Env +import GHC.Tc.Utils.Monad +import GHC.Tc.Utils.TcType +import qualified GHC.Types.Avail as Avail #if MIN_VERSION_ghc(9,2,0) -import GHC.Types.Meta +import GHC.Types.Meta #else -import GHC.Types.Basic -import GHC.Types.Id -#endif -import GHC.Types.Name hiding (varName) -import GHC.Types.Name.Occurrence hiding (varName) -import GHC.Types.Name.Cache -import GHC.Types.Name.Env -import GHC.Types.Name.Reader +import GHC.Types.Basic +import GHC.Types.Id +#endif +import GHC.Types.Name hiding (varName) +import GHC.Types.Name.Cache +import GHC.Types.Name.Env +import GHC.Types.Name.Reader #if MIN_VERSION_ghc(9,2,0) -import GHC.Types.SourceFile (HscSource(..), SourceModified(..)) +import GHC.Types.SourceFile (HscSource (..), + SourceModified (..)) #else -import GHC.Types.Name.Set +import GHC.Types.Name.Set #endif -import GHC.Types.SrcLoc (BufSpan, getRealSrcSpan) -import qualified GHC.Types.SrcLoc as SrcLoc -import GHC.Types.Unique.Supply -import GHC.Types.Var +import GHC.Types.SrcLoc (BufSpan) +import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.Unique.Supply +import GHC.Types.Var #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Env -import GHC.Unit.Finder -import GHC.Unit.Home.ModInfo +import GHC.Unit.Env +import GHC.Unit.Finder +import GHC.Unit.Home.ModInfo #endif -import GHC.Unit.Info (PackageName(..)) -import GHC.Unit.Module.Env +import GHC.Unit.Info (PackageName (..)) +import GHC.Unit.Module #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModDetails -import GHC.Unit.Module.ModIface (IfaceExport, mi_mod_hash) -#endif -import GHC.Unit.Module.Location -import GHC.Unit.Module.Name -import GHC.Unit.State (ModuleOrigin(..)) -import GHC.Unit.Types (UnitId, unitString, IsBootInterface(..)) -import GHC.Utils.Fingerprint -import GHC.Utils.Panic -import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModGuts +import GHC.Unit.Module.ModIface (IfaceExport, mi_mod_hash) +#endif +import GHC.Unit.State (ModuleOrigin (..)) +import GHC.Utils.Panic hiding (try) #else -import Bag -import ConLike (ConLike(..), conLikeName, conLikeFieldLabels) -import DataCon (dataConWrapId) -import DynFlags hiding (ExposePackage) +import ConLike +import DataCon +import DynFlags hiding (ExposePackage) import qualified DynFlags -import FastString -import FieldLabel (FieldLabel, flSelector, flLabel) import Finder -import Fingerprint -import Maybes import Module #if MIN_VERSION_ghc(9,0,1) -import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) -import GHC.Core.TyCo.Ppr (pprSigmaType) -import GHC.Core.TyCo.Rep (Scaled, scaledThing) +import GHC.Core.TyCo.Ppr (pprSigmaType) +import GHC.Core.TyCo.Rep (Scaled, scaledThing) import GHC.Iface.Load -import GHC.Types.Unique.Set (emptyUniqSet) -import Module (unitString) +import GHC.Types.Unique.Set (emptyUniqSet) +import Module (unitString) #endif - import qualified Avail -import HscTypes +import BasicTypes +import Class +import CmdLineParser (Warn (..)) +import CoreUtils (exprType) +import DriverPhases +import DriverPipeline +import DsExpr +import DsMonad +import ExtractDocs (extractDocs) +import FamInst +import FamInstEnv +import GHCi +import GhcMonad import HeaderInfo -import NameEnv -import HscMain import Hooks -import IfaceType +import HscMain +import HscTypes +import Id +import IfaceSyn +import InstEnv +import Lexer import Linker import LoadIface import MkIface -import Name hiding (varName) +import Name hiding (varName) import NameCache +import NameEnv +import NameSet import Packages -import Panic +import Panic hiding (try) import Parser +import PatSyn +#if MIN_VERSION_ghc(8,8,0) +import Plugins +#endif +import PprTyThing import PrelInfo +import PrelNames import RdrName +import RnNames +import RnSplice import qualified SrcLoc -import StringBuffer import TcEnv +import TcEvidence import TcIface import TcRnDriver import TcRnMonad +import TcType +import TidyPgm import qualified TyCoRep - import TyCon +import Type +import TysPrim +import TysWiredIn import UniqSupply import Var -import TidyPgm -import DriverPipeline -import DriverPhases -import TysWiredIn -import BasicTypes -import Lexer -import GHCi -import ExtractDocs (extractDocs) -import PatSyn -import NameSet -import Id -import GhcMonad #if MIN_VERSION_ghc(8,10,0) -import TyCoTidy -import Predicate -import Type -import Pair -import Coercion (coercionKind) +import Coercion (coercionKind) +import Predicate #else -import SrcLoc (RealLocated) -import Type +import SrcLoc (RealLocated) #endif #endif -#if MIN_VERSION_ghc(9,2,0) --- We are using Safe here, which is not equivalent, but probably what we want. -gcatch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a -gcatch = Safe.catch - -#elif MIN_VERSION_ghc(9,0,0) --- We are using Safe here, which is not equivalent, but probably what we want. -gcatch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a -gcatch = Safe.catch -#endif #if !MIN_VERSION_ghc(9,0,0) type BufSpan = () @@ -673,7 +868,7 @@ pattern AvailFL :: FieldLabel -> Avail.AvailInfo pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl) #else -- pattern synonym that is never populated -pattern AvailFL x <- Avail.Avail ((\_ -> (True, undefined)) -> (False, x)) +pattern AvailFL x <- Avail.Avail (const (True, undefined) -> (False, x)) #endif {-# COMPLETE AvailTC, AvailName, AvailFL #-} @@ -738,3 +933,33 @@ addBootSuffixLocnOut locn getRealSrcSpan :: RealLocated a -> SrcLoc.RealSrcSpan getRealSrcSpan = SrcLoc.getLoc #endif + +dataConExTyCoVars :: DataCon -> [TyCoVar] +#if __GLASGOW_HASKELL__ >= 808 +dataConExTyCoVars = DataCon.dataConExTyCoVars +#else +dataConExTyCoVars = DataCon.dataConExTyVars +#endif + +#if !MIN_VERSION_ghc(9,0,0) +-- Linear Haskell +type Scaled a = a +scaledThing :: Scaled a -> a +scaledThing = id +#endif + +mkVisFunTys :: [Scaled Type] -> Type -> Type +mkVisFunTys = +#if __GLASGOW_HASKELL__ <= 808 + mkFunTys +#else + TcType.mkVisFunTys +#endif + +mkInfForAllTys :: [TyVar] -> Type -> Type +mkInfForAllTys = +#if MIN_VERSION_ghc(9,0,0) + TcType.mkInfForAllTys +#else + mkInvForAllTys +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index b744545c13..39c0d2a616 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -5,7 +5,10 @@ module Development.IDE.GHC.Compat.Env ( Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph, hsc_HPT, hsc_type_env_var), InteractiveContext(..), + setInteractivePrintName, + setInteractiveDynFlags, Env.hsc_dflags, + hsc_EPS, hsc_logger, hsc_tmpfs, hsc_unit_env, @@ -17,45 +20,65 @@ module Development.IDE.GHC.Compat.Env ( HomeUnit, setHomeUnitId_, mkHomeModule, - -- * Export so other compats works better + -- * Provide backwards Compatible + -- types and helper functions. Logger(..), UnitEnv, + hscSetUnitEnv, hscSetFlags, initTempFs, -- * Home Unit homeUnitId_, -- * DynFlags Helper setBytecodeLinkerOptions, + setInterpreterLinkerOptions, + -- * Ways + Ways, + Way, + hostFullWays, + setWays, + wayGeneralFlags, + wayUnsetGeneralFlags, + -- * Backend, backwards compatible Backend, setBackend, platformDefaultBackend, ) where -import GHC +import GHC (setInteractiveDynFlags) + #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Env as Env -import GHC.Unit.Env (UnitEnv) -import GHC.Utils.TmpFs +import GHC.Driver.Env (HscEnv) +import qualified GHC.Driver.Env as Env +import qualified GHC.Driver.Session as Home +import GHC.Platform.Ways hiding (hostFullWays) +import qualified GHC.Platform.Ways as Ways +import GHC.Unit.Env (UnitEnv) +import GHC.Utils.TmpFs #else -import GHC.Driver.Types (InteractiveContext(..)) -import qualified GHC.Driver.Types as Env +import qualified GHC.Driver.Session as DynFlags +import GHC.Driver.Types (HscEnv, InteractiveContext (..), hsc_EPS, + setInteractivePrintName) +import qualified GHC.Driver.Types as Env +import GHC.Driver.Ways hiding (hostFullWays) +import qualified GHC.Driver.Ways as Ways #endif -import GHC.Driver.Hooks (Hooks) -import GHC.Unit.Types (UnitId, Unit) -import qualified GHC.Driver.Session as Home -import GHC.Driver.Session hiding (mkHomeModule) +import GHC.Driver.Hooks (Hooks) +import GHC.Driver.Session hiding (mkHomeModule) +import GHC.Unit.Module.Name +import GHC.Unit.Types (Module, Unit, UnitId, mkModule) #else -import HscTypes as Env -import Module (toInstalledUnitId) -import DynFlags (emptyFilesToClean, thisPackage, LogAction) -#if !MIN_VERSION_ghc(8,10,0) -import qualified DynFlags -#endif -import Hooks +import DynFlags +import Hooks +import HscTypes as Env +import Module #endif -import Data.IORef +#if MIN_VERSION_ghc(9,0,0) +import qualified Data.Set as Set +#endif +import Data.IORef #if !MIN_VERSION_ghc(9,2,0) @@ -93,6 +116,13 @@ initTempFs env = do pure $ hscSetFlags dflags env #endif +hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv +#if MIN_VERSION_ghc(9,2,0) +hscSetUnitEnv ue env = env { hsc_unit_env = ue } +#else +hscSetUnitEnv _ env = env +#endif + hsc_unit_env :: HscEnv -> UnitEnv hsc_unit_env = #if MIN_VERSION_ghc(9,2,0) @@ -114,7 +144,7 @@ hsc_logger = #if MIN_VERSION_ghc(9,2,0) Env.hsc_logger #else - Logger . GHC.log_action . Env.hsc_dflags + Logger . DynFlags.log_action . Env.hsc_dflags #endif hsc_hooks :: HscEnv -> Hooks @@ -182,6 +212,48 @@ setBytecodeLinkerOptions df = df { , ghcMode = CompManager } +setInterpreterLinkerOptions :: DynFlags -> DynFlags +setInterpreterLinkerOptions df = df { + ghcLink = LinkInMemory +#if MIN_VERSION_ghc(9,2,0) + , backend = Interpreter +#else + , hscTarget = HscInterpreted +#endif + , ghcMode = CompManager + } + +-- ------------------------------------------------------- +-- Ways helpers +-- ------------------------------------------------------- + +#if !MIN_VERSION_ghc(9,2,0) && MIN_VERSION_ghc(9,0,0) +type Ways = Set.Set Way +#elif !MIN_VERSION_ghc(9,0,0) +type Ways = [Way] +#endif + +hostFullWays :: Ways +hostFullWays = +#if MIN_VERSION_ghc(9,0,0) + Ways.hostFullWays +#else + interpWays +#endif + +setWays :: Ways -> DynFlags -> DynFlags +setWays ways flags = +#if MIN_VERSION_ghc(9,2,0) + flags { targetWays = ways} +#elif MIN_VERSION_ghc(9,0,0) + flags {ways = ways} +#else + updateWays $ flags {ways = ways} +#endif + +-- ------------------------------------------------------- +-- Backend helpers +-- ------------------------------------------------------- #if !MIN_VERSION_ghc(9,2,0) type Backend = HscTarget diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index c6d8b5a31c..b59e95908b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -6,23 +6,23 @@ module Development.IDE.GHC.Compat.Iface ( cannotFindModule, ) where -import GHC +import GHC #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Iface.Load as Iface -import qualified GHC.Unit.Finder as Finder -import GHC.Unit.Finder.Types (FindResult) +import qualified GHC.Iface.Load as Iface +import qualified GHC.Unit.Finder as Finder +import GHC.Unit.Finder.Types (FindResult) #elif MIN_VERSION_ghc(9,0,0) -import qualified GHC.Iface.Load as Iface -import GHC.Driver.Types (FindResult) -import qualified GHC.Driver.Finder as Finder +import qualified GHC.Driver.Finder as Finder +import GHC.Driver.Types (FindResult) +import qualified GHC.Iface.Load as Iface #else -import qualified MkIface -import Finder (FindResult) +import Finder (FindResult) import qualified Finder +import qualified MkIface #endif -import Development.IDE.GHC.Compat.Env -import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Outputable writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 13c2fc45ea..53eb38c9cc 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -5,19 +5,25 @@ module Development.IDE.GHC.Compat.Logger ( pushLogHook, -- * Logging stuff LogActionCompat, - logActionCompat + logActionCompat, + defaultLogActionHPutStrDoc, ) where -import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env as Env -import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env as Env +import Development.IDE.GHC.Compat.Outputable #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Session as DynFlags -import GHC.Utils.Outputable +import GHC.Driver.Session as DynFlags +import GHC.Utils.Outputable +#if MIN_VERSION_ghc(9,2,0) +import GHC.Utils.Logger #else -import DynFlags -import Outputable (queryQual) +import GHC.Driver.Session +#endif +#else +import DynFlags +import Outputable (queryQual) #endif putLogHook :: Logger -> HscEnv -> HscEnv diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index fb9e22d13a..be730e5bf6 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -6,8 +6,7 @@ module Development.IDE.GHC.Compat.Outputable ( showSDoc, showSDocUnsafe, showSDocForUser, - ppr, - pprPanic, + ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, printSDocQualifiedUnsafe, printNameWithoutUniques, printSDocAllTheWay, diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index bf9ac42eec..d746202f8a 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -19,43 +19,49 @@ module Development.IDE.GHC.Compat.Parser ( mkApiAnns, ) where -import GHC (RealSrcLoc) - #if MIN_VERSION_ghc(9,0,0) -import qualified GHC.Parser.Lexer as Lexer +import qualified GHC.Parser.Lexer as Lexer #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Config as Config +import qualified GHC.Driver.Config as Config #else -import qualified GHC.Parser.Annotation as Anno +import qualified GHC.Parser.Annotation as Anno #endif #else -import Lexer -import StringBuffer -import qualified ApiAnnotation as Anno +import qualified ApiAnnotation as Anno +import Lexer import qualified SrcLoc #endif -import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Util #if !MIN_VERSION_ghc(9,2,0) -import qualified Data.Map as Map +import qualified Data.Map as Map +#endif +#if !MIN_VERSION_ghc(9,0,0) type ParserOpts = DynFlags +#elif !MIN_VERSION_ghc(9,2,0) +type ParserOpts = Lexer.ParserFlags #endif initParserOpts :: DynFlags -> ParserOpts initParserOpts = #if MIN_VERSION_ghc(9,2,0) - Config.initParserOpts + Config.initParserOpts +#elif MIN_VERSION_ghc(9,0,0) + Lexer.mkParserFlags #else - id + id #endif initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState initParserState = #if MIN_VERSION_ghc(9,2,0) - Lexer.initParserState + Lexer.initParserState +#elif MIN_VERSION_ghc(9,0,0) + Lexer.mkPStatePure #else - Lexer.mkPState + Lexer.mkPState #endif #if MIN_VERSION_ghc(9,2,0) @@ -67,24 +73,24 @@ type ApiAnns = Anno.ApiAnns mkHsParsedModule :: ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule mkHsParsedModule parsed fps hpm_annotations = - (HsParsedModule - parsed - fps + HsParsedModule + parsed + fps #if !MIN_VERSION_ghc(9,2,0) - hpm_annotations + hpm_annotations #endif - ) + mkParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule mkParsedModule ms parsed extra_src_files _hpm_annotations = - ParsedModule { - pm_mod_summary = ms - , pm_parsed_source = parsed - , pm_extra_src_files = extra_src_files + ParsedModule { + pm_mod_summary = ms + , pm_parsed_source = parsed + , pm_extra_src_files = extra_src_files #if !MIN_VERSION_ghc(9,2,0) - , pm_annotations = _hpm_annotations + , pm_annotations = _hpm_annotations #endif - } + } mkApiAnns :: PState -> ApiAnns #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index f16e35cca3..4d63b9113e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -2,29 +2,36 @@ -- | Plugin Compat utils. module Development.IDE.GHC.Compat.Plugins ( + Plugin(..), + defaultPlugin, +#if __GLASGOW_HASKELL__ >= 808 + PluginWithArgs(..), +#endif applyPluginsParsedResultAction, initializePlugins, ) where -import GHC +import GHC #if MIN_VERSION_ghc(9,0,0) -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env -#else -import GHC.Driver.Types -#endif -import GHC.Driver.Plugins (Plugin (parsedResultAction), withPlugins) -import qualified GHC.Runtime.Loader as Loader -import GHC.Parser.Lexer +import GHC.Driver.Plugins (Plugin (..), + PluginWithArgs (..), + defaultPlugin, withPlugins) +import qualified GHC.Runtime.Loader as Loader +#elif __GLASGOW_HASKELL__ >= 808 +import qualified DynamicLoading as Loader +import Plugins (Plugin (..), + PluginWithArgs (..), + defaultPlugin, withPlugins) #else -import Plugins (Plugin(parsedResultAction), withPlugins ) -import qualified DynamicLoading as Loader +import qualified DynamicLoading as Loader +import Plugins (Plugin (..), defaultPlugin, + withPlugins) #endif -import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) -import Development.IDE.GHC.Compat.Parser as Parser +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) +import Development.IDE.GHC.Compat.Parser as Parser -applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> IO (ParsedSource) +applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> IO ParsedSource applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do -- Apply parsedResultAction of plugins let applyPluginAction p opts = parsedResultAction p opts ms diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index d56c83412b..8b3c38f954 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} -- | Compat module for 'UnitState' and 'UnitInfo'. module Development.IDE.GHC.Compat.Units ( @@ -29,6 +29,8 @@ module Development.IDE.GHC.Compat.Units ( -- * UnitId helpers UnitId, Unit, + unitString, + stringToUnit, #if !MIN_VERSION_ghc(9,0,0) pattern RealUnit, #endif @@ -39,41 +41,54 @@ module Development.IDE.GHC.Compat.Units ( toUnitId, moduleUnitId, moduleUnit, + -- * ExternalPackageState + ExternalPackageState(..), -- * Utils filterInplaceUnits, ) where #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Env +import GHC.Unit.Env #else -import GHC.Driver.Session (PackageFlag(..), PackageArg(..)) -import qualified GHC.Driver.Session as DynFlags +import GHC.Driver.Session (PackageArg (..), + PackageFlag (..)) +import qualified GHC.Driver.Session as DynFlags +import GHC.Driver.Types #endif -import qualified GHC.Unit.Info as UnitInfo -import GHC.Unit.Module.Name (ModuleName) -import GHC.Unit.Types (UnitId, Unit, GenUnit(..), Definite(..), GenModule(Module), InstalledModule, Module) -import qualified GHC.Unit.Types as Unit -import GHC.Unit.State (UnitState(unitInfoMap), UnitInfo, PackageName, LookupResult) -import qualified GHC.Unit.State as State -import GHC.Types.Unique.Set -import GHC.Data.FastString +import GHC.Data.FastString +import GHC.Types.Unique.Set +import qualified GHC.Unit.Info as UnitInfo +import GHC.Unit.Module.Name (ModuleName) +import GHC.Unit.State (LookupResult, PackageName, + UnitInfo, + UnitState (unitInfoMap)) +import qualified GHC.Unit.State as State +import GHC.Unit.Types hiding (moduleUnit, toUnitId) +import qualified GHC.Unit.Types as Unit #else +import DynFlags (PackageArg (..), + PackageFlag (..)) import qualified DynFlags -import DynFlags (PackageFlag(..), PackageArg(..)) -import Packages (PackageState, PackageConfig, PackageConfigMap, lookupPackage', getPackageConfigMap, LookupResult, PackageName, InstalledPackageInfo (packageName, haddockInterfaces)) -import qualified Packages +import FastString +import HscTypes +import Module hiding (moduleUnitId) import qualified Module -import Module hiding (moduleUnitId) -import FastString +import Packages (InstalledPackageInfo (haddockInterfaces, packageName), + LookupResult, PackageConfig, + PackageConfigMap, PackageName, + PackageState, + getPackageConfigMap, + lookupPackage') +import qualified Packages #endif -import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Env #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) -import Data.Map (Map) +import Data.Map (Map) #endif -import Data.Version -import Data.Either +import Data.Either +import Data.Version #if MIN_VERSION_ghc(9,0,0) type PreloadUnitClosure = UniqSet UnitId @@ -90,6 +105,15 @@ type PreloadUnitClosure = () type Unit = UnitId #endif + +#if !MIN_VERSION_ghc(9,0,0) +unitString :: Unit -> String +unitString = Module.unitIdString + +stringToUnit :: String -> Unit +stringToUnit = Module.stringToUnitId +#endif + unitState :: HscEnv -> UnitState #if MIN_VERSION_ghc(9,2,0) unitState = ue_units . hsc_unit_env @@ -121,53 +145,53 @@ initUnits env = do } pure $ hscSetFlags dflags env { hsc_unit_env = unit_env } #elif MIN_VERSION_ghc(9,0,0) - newFlags <- State.initUnits $ hsc_dflags env - pure $ hscSetFlags newFlags env + newFlags <- State.initUnits $ hsc_dflags env + pure $ hscSetFlags newFlags env #else - newFlags <- fmap fst . Packages.initPackages $ hsc_dflags env - pure $ hscSetFlags newFlags env + newFlags <- fmap fst . Packages.initPackages $ hsc_dflags env + pure $ hscSetFlags newFlags env #endif explicitUnits :: UnitState -> [Unit] explicitUnits ue = #if MIN_VERSION_ghc(9,0,0) - State.explicitUnits ue + State.explicitUnits ue #else - Packages.explicitPackages ue + Packages.explicitPackages ue #endif listVisibleModuleNames :: HscEnv -> [ModuleName] listVisibleModuleNames env = #if MIN_VERSION_ghc(9,0,0) - State.listVisibleModuleNames $ unitState env + State.listVisibleModuleNames $ unitState env #else - Packages.listVisibleModuleNames $ hsc_dflags env + Packages.listVisibleModuleNames $ hsc_dflags env #endif getUnitName :: HscEnv -> UnitId -> Maybe PackageName getUnitName env i = #if MIN_VERSION_ghc(9,0,0) - State.unitPackageName <$> State.lookupUnitId (unitState env) i + State.unitPackageName <$> State.lookupUnitId (unitState env) i #else - packageName <$> Packages.lookupPackage (hsc_dflags env) (definiteUnitId (defUnitId i)) + packageName <$> Packages.lookupPackage (hsc_dflags env) (definiteUnitId (defUnitId i)) #endif lookupModuleWithSuggestions :: HscEnv -> ModuleName -> Maybe FastString -> LookupResult lookupModuleWithSuggestions env modname mpkg = #if MIN_VERSION_ghc(9,0,0) - State.lookupModuleWithSuggestions (unitState env) modname mpkg + State.lookupModuleWithSuggestions (unitState env) modname mpkg #else - Packages.lookupModuleWithSuggestions (hsc_dflags env) modname mpkg + Packages.lookupModuleWithSuggestions (hsc_dflags env) modname mpkg #endif getUnitInfoMap :: HscEnv -> UnitInfoMap getUnitInfoMap = #if MIN_VERSION_ghc(9,2,0) - unitInfoMap . ue_units . hsc_unit_env + unitInfoMap . ue_units . hsc_unit_env #elif MIN_VERSION_ghc(9,0,0) - unitInfoMap . unitState + unitInfoMap . unitState #else - Packages.getPackageConfigMap . hsc_dflags + Packages.getPackageConfigMap . hsc_dflags #endif lookupUnit :: HscEnv -> Unit -> Maybe UnitInfo @@ -196,9 +220,9 @@ preloadClosureUs = const () unitExposedModules :: UnitInfo -> [(ModuleName, Maybe Module)] unitExposedModules ue = #if MIN_VERSION_ghc(9,0,0) - UnitInfo.unitExposedModules ue + UnitInfo.unitExposedModules ue #else - Packages.exposedModules ue + Packages.exposedModules ue #endif unitDepends :: UnitInfo -> [UnitId] @@ -211,33 +235,33 @@ unitDepends = fmap (Module.DefiniteUnitId. defUnitId') . Packages.depends unitPackageNameString :: UnitInfo -> String unitPackageNameString = #if MIN_VERSION_ghc(9,0,0) - UnitInfo.unitPackageNameString + UnitInfo.unitPackageNameString #else - Packages.packageNameString + Packages.packageNameString #endif unitPackageVersion :: UnitInfo -> Version unitPackageVersion = #if MIN_VERSION_ghc(9,0,0) - UnitInfo.unitPackageVersion + UnitInfo.unitPackageVersion #else - Packages.packageVersion + Packages.packageVersion #endif unitInfoId :: UnitInfo -> Unit unitInfoId = #if MIN_VERSION_ghc(9,0,0) - UnitInfo.mkUnit + UnitInfo.mkUnit #else - Packages.packageConfigId + Packages.packageConfigId #endif unitHaddockInterfaces :: UnitInfo -> [FilePath] unitHaddockInterfaces = #if MIN_VERSION_ghc(9,0,0) - UnitInfo.unitHaddockInterfaces + UnitInfo.unitHaddockInterfaces #else - haddockInterfaces + haddockInterfaces #endif -- ------------------------------------------------------------------ diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs new file mode 100644 index 0000000000..198a94c03b --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +-- | GHC Utils and Datastructures re-exports. +-- +-- Mainly handles module hierarchy re-organisation of GHC +-- from version < 9.0 to >= 9.0. +-- +-- Some Functions, such as 'toList' shadow other function-names. +-- This way this module can be imported qualified more naturally. +module Development.IDE.GHC.Compat.Util ( + -- * Exception handling + MonadCatch, + GhcException, + handleGhcException, + catch, + try, + -- * Bags + Bag, + bagToList, + listToBag, + unionBags, + isEmptyBag, + -- * Boolean Formula + LBooleanFormula, + BooleanFormula(..), + -- * OverridingBool + OverridingBool(..), + -- * Maybes + MaybeErr(..), + orElse, +#if MIN_VERSION_ghc(8,10,0) + -- * Pair + Pair(..), +#endif + -- * EnumSet + EnumSet, + toList, + -- * FastString exports + FastString, +#if MIN_VERSION_ghc(9,2,0) + -- Export here, so we can coerce safely on consumer sites + LexicalFastString(..), +#endif + uniq, + unpackFS, + mkFastString, + fsLit, + pprHsString, + -- * Fingerprint + Fingerprint(..), + getFileHash, + fingerprintData, + fingerprintString, + fingerprintFingerprints, + -- * Unique + Uniquable, + nonDetCmpUnique, + getUnique, + Unique, + mkUnique, + newTagUnique, + -- * String Buffer + StringBuffer(..), + hGetStringBuffer, + stringToStringBuffer, + ) where + +#if MIN_VERSION_ghc(9,0,0) +import Control.Exception.Safe (MonadCatch, catch, try) +import GHC.Data.Bag +import GHC.Data.BooleanFormula +import GHC.Data.EnumSet + +import GHC.Data.FastString +import GHC.Data.Maybe +import GHC.Data.Pair +import GHC.Data.StringBuffer +import GHC.Types.Unique +import GHC.Utils.Fingerprint +import GHC.Utils.Misc +import GHC.Utils.Outputable (pprHsString) +import GHC.Utils.Panic hiding (try) +#else +import Bag +import BooleanFormula +import EnumSet +import qualified Exception +import FastString +import Fingerprint +import Maybes +#if MIN_VERSION_ghc(8,10,0) +import Pair +#endif +import Outputable (pprHsString) +import Panic hiding (try) +import StringBuffer +import Unique +import Util +#endif + +#if !MIN_VERSION_ghc(9,0,0) +type MonadCatch = Exception.ExceptionMonad + +-- We are using Safe here, which is not equivalent, but probably what we want. +catch :: (Exception.ExceptionMonad m, Exception e) => m a -> (e -> m a) -> m a +catch = Exception.gcatch + +try :: (Exception.ExceptionMonad m, Exception e) => m a -> m (Either e a) +try = Exception.gtry +#endif diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index eb412685fc..5a17c6643d 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -32,7 +32,9 @@ module Development.IDE.GHC.Error import Data.Maybe import Data.String (fromString) import qualified Data.Text as T +import qualified Development.IDE.GHC.Compat.Outputable as Compat import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat.Util as Compat import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics as D diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 3bbdc231bb..b4d88cf201 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -53,6 +53,7 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable import Development.IDE.Graph (RuleResult, Rules) import Development.IDE.Graph.Classes import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 7c41f3eda6..cd660b3db6 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -73,7 +73,7 @@ import qualified GHC.Types.SrcLoc as SrcLoc #endif import GHC import Control.Concurrent -import Control.Exception +import Control.Exception as E import Data.Binary.Put (Put, runPut) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) @@ -87,6 +87,8 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import Data.Typeable import Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Util import qualified Development.IDE.GHC.Compat.Units as Compat import qualified Development.IDE.GHC.Compat.Parser as Compat import Development.IDE.Types.Location @@ -236,7 +238,7 @@ hDuplicateTo' h1@(FileHandle path m1) h2@(FileHandle _ m2) = do -- _ <- hClose_help h2_ -- hClose_help does two things: -- 1. It flushes the buffer, we replicate this here - _ <- flushWriteBuffer h2_ `catch` \(_ :: IOException) -> pure () + _ <- flushWriteBuffer h2_ `E.catch` \(_ :: IOException) -> pure () -- 2. It closes the handle. This is redundant since dup2 takes care of that -- but even worse it is actively harmful! Once the handle has been closed -- another thread is free to reallocate it. This leads to dup2 failing with EBUSY diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs index 39d851f0cc..a10d9dad12 100644 --- a/ghcide/src/Development/IDE/GHC/Warnings.hs +++ b/ghcide/src/Development/IDE/GHC/Warnings.hs @@ -9,6 +9,7 @@ import Control.Concurrent.Strict import qualified Data.Text as T import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error import Development.IDE.Types.Diagnostics import Language.LSP.Types (type (|?) (..)) diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 32de8a8c85..476e6969b1 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -14,6 +14,8 @@ module Development.IDE.Import.FindImports ) where import Development.IDE.GHC.Compat as Compat +import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error as ErrUtils import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 82bdc573cd..7b07195c54 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -18,6 +18,7 @@ import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error (rangeToRealSrcSpan, realSrcSpanToRange) import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index cc535d1d8f..f9b4f1a7df 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -42,6 +42,8 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules import Development.IDE.Core.Service import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util (prettyPrint, printRdrName, diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 0771ef6cc8..ec09090d79 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -30,6 +30,8 @@ import Data.Maybe (fromJust, isNothing, mapMaybe) import qualified Data.Text as T import Development.IDE.GHC.Compat +import qualified Development.IDE.GHC.Compat.Util as Util +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), Annotate) @@ -448,5 +450,5 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do ty wild (filter ((/= symbol) . unqualIEWrapName . unLoc) cons) - (filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds) + (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds) killLie v = Just v diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 610c7a68ab..9aab9bce9e 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -35,7 +35,9 @@ import qualified Data.Set as Set import qualified Data.HashSet as HashSet import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat as GHC hiding (ppr) +import Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Compat.Outputable hiding (ppr) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index fdbb05e257..7a1a9469ac 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -28,7 +28,6 @@ import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.Graph (Action) import Development.IDE.LSP.Server -import Development.IDE.Plugin import qualified Development.IDE.Plugin as P import Development.IDE.Types.Action import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) @@ -51,7 +50,7 @@ data TestRequest newtype WaitForIdeRuleResult = WaitForIdeRuleResult { ideResultSuccess::Bool} deriving newtype (FromJSON, ToJSON) -plugin :: Plugin c +plugin :: P.Plugin c plugin = def { P.pluginRules = return (), P.pluginHandlers = requestHandler (SCustomMethod "test") testRequestHandler' diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index da73a35ece..36930d4388 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -33,6 +33,7 @@ import Development.IDE.Core.Rules (IdeState, runAction) import Development.IDE.Core.Service (getDiagnostics) import Development.IDE.Core.Shake (getHiddenDiagnostics, use) import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Util (printName) import Development.IDE.Graph.Classes import Development.IDE.Spans.LocalBindings (Bindings, getFuzzyScope) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index bed9b9e44a..19a391c56d 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -30,6 +30,8 @@ import Language.LSP.Types import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Outputable +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.Spans.Common import Development.IDE.Types.Options @@ -325,7 +327,7 @@ nameToLocation hiedb lookupModule name = runMaybeT $ case nameSrcSpan name of sp@(RealSrcSpan rsp _) -- Lookup in the db if we got a location in a boot file - | fs <- unpackFS (srcSpanFile rsp) + | fs <- Util.unpackFS (srcSpanFile rsp) , not $ "boot" `isSuffixOf` fs -> do itExists <- liftIO $ doesFileExist fs diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 9b52942e2a..8afe4f72fe 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -25,6 +25,7 @@ import qualified Data.Text as T import Development.IDE.Core.Compile import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.Spans.Common import System.Directory diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index 66c4cc7759..aa8d1bad60 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -22,6 +22,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Unique import Development.IDE.GHC.Compat +import qualified Development.IDE.GHC.Compat.Util as Maybes import Development.IDE.GHC.Error (catchSrcErrors) import Development.IDE.GHC.Util (lookupPackageConfig) import Development.IDE.Graph.Classes @@ -87,8 +88,8 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do (mkModule (unitInfoId pkg) mn) (ImportByUser NotBoot) return $ case modIface of - Failed _r -> Nothing - Succeeded mi -> Just mi + Maybes.Failed _r -> Nothing + Maybes.Succeeded mi -> Just mi modIfaces <- mapMaybeM doOne targets return $ createExportsMap modIfaces diff --git a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs index c4d4d7aa1b..91d46d844b 100644 --- a/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs +++ b/plugins/hls-brittany-plugin/src/Ide/Plugin/Brittany.hs @@ -13,7 +13,7 @@ import Data.Semigroup import Data.Text (Text) import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts), topDir) +import qualified Development.IDE.GHC.Compat as GHC hiding (Cpp) import qualified DynFlags as D import qualified EnumSet as S import GHC.LanguageExtensions.Type @@ -41,7 +41,6 @@ import qualified Data.Text as Text import qualified Language.Haskell.GHC.ExactPrint as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint import qualified Data.Text.Lazy as TextL -import qualified DynFlags as GHC import qualified GHC import qualified GHC.LanguageExtensions.Type as GHC @@ -61,8 +60,8 @@ provider ide typ contents nfp opts = liftIO $ do FormatText -> (fullRange contents, contents) FormatRange r -> (normalize r, extractRange r contents) modsum <- fmap msrModSummary $ runAction "brittany" ide $ use_ GetModSummaryWithoutTimestamps nfp - let dflags = ms_hspp_opts modsum - let withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key) + let dflags = GHC.ms_hspp_opts modsum + let withRuntimeLibdir = bracket_ (setEnv key $ GHC.topDir dflags) (unsetEnv key) where key = "GHC_EXACTPRINT_GHC_LIBDIR" res <- withRuntimeLibdir $ formatText dflags confFile opts selectedContents case res of diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs index 602fb328f8..e54c7721ab 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs @@ -37,7 +37,6 @@ import Ide.Plugin.CallHierarchy.Types import Ide.Types import Language.LSP.Types import qualified Language.LSP.Types.Lens as L -import Name import Text.Read (readMaybe) -- | Render prepare call hierarchy request. diff --git a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs index 1ba3a793f8..9a855958c1 100644 --- a/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs +++ b/plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs @@ -14,7 +14,6 @@ import Development.IDE.GHC.Compat import HieDb (HieDb (getConn), Symbol (..), toNsChar) import Ide.Plugin.CallHierarchy.Types -import Name incomingCalls :: HieDb -> Symbol -> IO [Vertex] incomingCalls (getConn -> conn) symbol = do @@ -78,5 +77,5 @@ parseSymbol :: Symbol -> (String, String, String) parseSymbol Symbol{..} = let o = toNsChar (occNameSpace symName) : occNameString symName m = moduleNameString $ moduleName symModule - u = unitString $ moduleUnitId symModule + u = unitString $ moduleUnit symModule in (o, m, u) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs index 6ec932e4a5..fa81a76c07 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs @@ -8,12 +8,10 @@ module Ide.Plugin.Class ( descriptor ) where -import BooleanFormula -import Class -import ConLike import Control.Applicative import Control.Lens hiding (List, use) import Control.Monad +import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Aeson @@ -26,10 +24,9 @@ import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.PositionMapping (fromCurrentRange, toCurrentRange) import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Util import Development.IDE.Spans.AtPoint import qualified GHC.Generics as Generics -import GhcPlugins hiding (Var, getLoc, - (<>)) import Ide.PluginUtils import Ide.Types import Language.Haskell.GHC.ExactPrint @@ -38,8 +35,6 @@ import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, Parens) import Language.LSP.Server import Language.LSP.Types import qualified Language.LSP.Types.Lens as J -import TcEnv -import TcRnMonad descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs index 7497ae783a..be013e2dc2 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs @@ -6,22 +6,20 @@ module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalSetup, propSetup, testCheck, asStatements,myExecStmt) where import Control.Lens ((^.)) +import Control.Monad.IO.Class import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff) import qualified Data.List.NonEmpty as NE import Data.String (IsString) import qualified Data.Text as T +import Development.IDE.GHC.Compat import Development.IDE.Types.Location (Position (..), Range (..)) import GHC (ExecOptions, ExecResult (..), execStmt) -import GhcMonad (Ghc, liftIO, modifySession) -import HscTypes import Ide.Plugin.Eval.Types (Language (Plain), Loc, Located (..), Section (sectionLanguage), Test (..), Txt, locate, locate0) -import InteractiveEval (getContext, parseImportDecl, - runDecls, setContext) import Language.LSP.Types.Lens (line, start) import System.IO.Extra (newTempFile, readFile') diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index c7ef62b912..758ed4441f 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -25,7 +25,6 @@ module Ide.Plugin.Eval.CodeLens ( evalCommand, ) where -import CmdLineParser import Control.Applicative (Alternative ((<|>))) import Control.Arrow (second, (>>>)) import Control.Exception (try) @@ -72,59 +71,30 @@ import Development.IDE.Core.Compile (loadModulesHome, setupFinderCache) import Development.IDE.Core.PositionMapping (toCurrentRange) import Development.IDE.Core.Rules (TransitiveDependencies (transitiveModuleDeps)) -import Development.IDE.GHC.Compat (AnnotationComment (AnnBlockComment, AnnLineComment), - GenLocated (L), - GhcException, HscEnv, - ParsedModule (..), - SrcSpan (UnhelpfulSpan), - moduleName, - setInteractiveDynFlags, - srcSpanFile) +import Development.IDE.GHC.Compat hiding (unitState) +import qualified Development.IDE.GHC.Compat as Compat import qualified Development.IDE.GHC.Compat as SrcLoc +import Development.IDE.GHC.Compat.Util (GhcException, OverridingBool(..)) +import qualified Development.IDE.GHC.Compat.Util as FastString +import Development.IDE.GHC.Compat.Outputable import Development.IDE.Types.Options -import DynamicLoading (initializePlugins) -import FastString (unpackFS) import GHC (ClsInst, ExecOptions (execLineNumber, execSourceFile), FamInst, Fixity, - GeneralFlag (..), Ghc, - GhcLink (LinkInMemory), - GhcMode (CompManager), - GhcMonad (getSession), - HscTarget (HscInterpreted), + GhcMonad, LoadHowMuch (LoadAllTargets), - ModSummary (ms_hspp_opts), - NamedThing (getName, getOccName), + NamedThing (getName), SuccessFlag (Failed, Succeeded), - TcRnExprMode (..), - TyThing, defaultFixity, + TcRnExprMode (..), defaultFixity, execOptions, exprType, getInfo, getInteractiveDynFlags, - getSessionDynFlags, isImport, isStmt, load, parseName, pprFamInst, - pprInstance, runDecls, - setContext, setLogAction, - setSessionDynFlags, + pprInstance, setLogAction, setTargets, typeKind) import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) -import GhcPlugins (DynFlags (..), - defaultLogActionHPutStrDoc, - elemNameSet, gopt_set, - gopt_unset, hsc_dflags, - isSymOcc, mkNameSet, - parseDynamicFlagsCmdLine, - pprDefinedAt, - pprInfixName, - targetPlatform, - tyThingParent_maybe, - xopt_set, xopt_unset) - -import HscTypes (InteractiveImport (IIModule), - ModSummary (ms_mod), - Target (Target), - TargetId (TargetFile)) + import Ide.Plugin.Eval.Code (Statement, asStatements, evalSetup, myExecStmt, propSetup, resultRange, @@ -146,28 +116,15 @@ import Language.LSP.Types hiding SemanticTokenRelative (length)) import Language.LSP.Types.Lens (end, line) import Language.LSP.VFS (virtualFileText) -import Outputable (SDoc, empty, hang, nest, - ppr, showSDoc, text, - vcat, ($$), (<+>)) import System.FilePath (takeFileName) import System.IO (hClose) import UnliftIO.Temporary (withSystemTempFile) -import Util (OverridingBool (Never)) -import IfaceSyn (showToHeader) -import PprTyThing (pprTyThingInContext, - pprTypeForUser) #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Ways (hostFullWays, - wayGeneralFlags, - wayUnsetGeneralFlags) -import GHC.Parser.Annotation (ApiAnns (apiAnnRogueComments)) -import GHC.Parser.Lexer (mkParserFlags) +import GHC.Driver.Session (unitState, unitDatabases) import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) #else -import GhcPlugins (interpWays, updateWays, - wayGeneralFlags, - wayUnsetGeneralFlags) +import DynFlags #endif #if MIN_VERSION_ghc(9,0,0) @@ -180,7 +137,7 @@ apiAnnComments' :: SrcLoc.ApiAnns -> [SrcLoc.Located AnnotationComment] apiAnnComments' = concat . Map.elems . snd pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcSpan -pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x +pattern RealSrcSpanAlready x = SrcLoc.RealSrcSpan x Nothing #endif @@ -203,7 +160,7 @@ codeLens st plId CodeLensParams{_textDocument} = let comments = foldMap (\case L (RealSrcSpanAlready real) bdy - | unpackFS (srcSpanFile real) == + | FastString.unpackFS (srcSpanFile real) == fromNormalizedFilePath nfp , let ran0 = realSrcSpanToRange real , Just curRan <- toCurrentRange posMap ran0 @@ -387,7 +344,7 @@ runEvalCmd st EvalParams{..} = return $ Left err Succeeded -> do -- Evaluation takes place 'inside' the module - setContext [IIModule modName] + setContext [Compat.IIModule modName] Right <$> getSession edits <- @@ -601,11 +558,10 @@ evals (st, fp) df stmts = do dbg "{DECL " stmt void $ runDecls stmt return Nothing + pf = initParserOpts df #if !MIN_VERSION_ghc(9,0,0) - pf = df unhelpfulReason = "" #else - pf = mkParserFlags df unhelpfulReason = UnhelpfulInteractive #endif exec stmt l = @@ -766,7 +722,7 @@ doKindCmd True df arg = do doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text) doTypeCmd dflags arg = do let (emod, expr) = parseExprMode arg - ty <- exprType emod $ T.unpack expr + ty <- GHC.exprType emod $ T.unpack expr let rawType = T.strip $ T.pack $ showSDoc dflags $ pprTypeForUser ty broken = T.any (\c -> c == '\r' || c == '\n') rawType pure $ @@ -812,29 +768,20 @@ parseGhciLikeCmd input = do setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags setupDynFlagsForGHCiLike env dflags = do - let dflags3 = - dflags - { hscTarget = HscInterpreted - , ghcMode = CompManager - , ghcLink = LinkInMemory - } + let dflags3 = setInterpreterLinkerOptions dflags platform = targetPlatform dflags3 -#if MIN_VERSION_ghc(9,0,0) - evalWays = hostFullWays -#else - evalWays = interpWays -#endif - dflags3a = dflags3{ways = evalWays} + evalWays = Compat.hostFullWays + dflags3a = setWays evalWays dflags3 dflags3b = foldl gopt_set dflags3a $ - concatMap (wayGeneralFlags platform) evalWays + concatMap (Compat.wayGeneralFlags platform) evalWays dflags3c = foldl gopt_unset dflags3b $ - concatMap (wayUnsetGeneralFlags platform) evalWays + concatMap (Compat.wayUnsetGeneralFlags platform) evalWays dflags4 = dflags3c `gopt_set` Opt_ImplicitImportQualified `gopt_set` Opt_IgnoreOptimChanges `gopt_set` Opt_IgnoreHpcChanges `gopt_unset` Opt_DiagnosticsShowCaret - initializePlugins env dflags4 + Compat.hsc_dflags <$> Compat.initializePlugins (Compat.hscSetFlags dflags4 env) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs index ae3c26150c..b23888e587 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs @@ -17,18 +17,12 @@ import Data.List (isPrefixOf) import Data.Maybe (mapMaybe) import Data.String (fromString) import Development.IDE.GHC.Compat -import qualified EnumSet +import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Compat.Outputable +import qualified Development.IDE.GHC.Compat.Util as EnumSet + import GHC.LanguageExtensions.Type (Extension (..)) -import GhcMonad (modifySession) -import GhcPlugins (fsLit, hsc_IC, pprHsString) -import HscTypes (InteractiveContext (ic_dflags)) import Ide.Plugin.Eval.Util (asS, gStrictTry) -import qualified Lexer -import Outputable (Outputable (ppr), SDoc, - showSDocUnsafe, text, vcat, (<+>)) -import qualified Parser -import SrcLoc (mkRealSrcLoc) -import StringBuffer (stringToStringBuffer) {- $setup >>> import GHC @@ -72,9 +66,9 @@ pkgNames_ :: [PackageFlag] -> [String] pkgNames_ = mapMaybe ( \case - ExposePackage _ (PackageArg n) _ -> Just n - ExposePackage _ (UnitIdArg (DefiniteUnitId n)) _ -> Just $ asS n - _ -> Nothing + ExposePackage _ (PackageArg n) _ -> Just n + ExposePackage _ (UnitIdArg uid) _ -> Just $ asS uid + _ -> Nothing ) {- | Expose a list of packages. diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index 1c0a6822d0..675fa12a9e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -15,6 +15,7 @@ module Ide.Plugin.Eval.Util ( logWith, ) where +import Control.Exception (SomeException, evaluate) import Control.Monad.Extra (maybeM) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (lift) @@ -25,17 +26,16 @@ import Data.String (IsString (fromString)) import qualified Data.Text as T import Development.IDE (IdeState, Priority (..), ideLogger, logPriority) -import Development.IDE.GHC.Compat (gcatch) -import Exception (ExceptionMonad, SomeException (..), - evaluate) +import Development.IDE.GHC.Compat.Outputable + (Outputable, showSDocUnsafe, ppr) +import Development.IDE.GHC.Compat.Util + (MonadCatch, catch) import GHC.Exts (toList) import GHC.Stack (HasCallStack, callStack, srcLocFile, srcLocStartCol, srcLocStartLine) import Language.LSP.Server import Language.LSP.Types -import Outputable (Outputable (ppr), ppr, - showSDocUnsafe) import System.FilePath (takeExtension) import System.Time.Extra (duration, showDuration) import UnliftIO.Exception (catchAny) @@ -93,9 +93,9 @@ response' act = do _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing a) (\_ -> pure ()) return $ Right Null -gStrictTry :: ExceptionMonad m => m b -> m (Either String b) +gStrictTry :: (MonadIO m, MonadCatch m) => m b -> m (Either String b) gStrictTry op = - gcatch + catch (op >>= fmap Right . gevaluate) showErr diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 4194a79e27..d094c197d0 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -35,16 +35,6 @@ import Ide.PluginUtils (mkLspCommand) import Ide.Types import Language.LSP.Server import Language.LSP.Types -#if MIN_VERSION_ghc(9,0,0) -import GHC.Builtin.Names (pRELUDE) -#else -import PrelNames (pRELUDE) -#endif -import RnNames (findImportUsage, - getMinimalImports) -import qualified SrcLoc -import TcRnMonad (initTcWithGbl) -import TcRnTypes (TcGblEnv (tcg_used_gres)) importCommandId :: CommandId importCommandId = "ImportLensCommand" @@ -197,13 +187,13 @@ minimalImportsRule = define $ \MinimalImports nfp -> do (imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr let importsMap = Map.fromList - [ (SrcLoc.realSrcSpanStart l, T.pack (prettyPrint i)) - | L (OldRealSrcSpan l) i <- fromMaybe [] mbMinImports + [ (realSrcSpanStart l, T.pack (prettyPrint i)) + | L (RealSrcSpan l _) i <- fromMaybe [] mbMinImports ] res = - [ (i, Map.lookup (SrcLoc.realSrcSpanStart l) importsMap) + [ (i, Map.lookup (realSrcSpanStart l) importsMap) | i <- imports - , OldRealSrcSpan l <- [getLoc i] + , RealSrcSpan l _ <- [getLoc i] ] return ([], MinimalImportsResult res <$ mbMinImports) @@ -240,7 +230,7 @@ mkExplicitEdit pred posMapping (L src imp) explicit | ImportDecl {ideclHiding = Just (False, _)} <- imp = Nothing | not (isQualifiedImport imp), - OldRealSrcSpan l <- src, + RealSrcSpan l _ <- src, L _ mn <- ideclName imp, -- (almost) no one wants to see an explicit import list for Prelude pred mn, diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 5b443dfd9b..b65405a802 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -14,9 +14,8 @@ import Control.Monad.IO.Class import Data.Bifunctor (first) import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat (moduleNameString) -import qualified DynFlags as D -import qualified EnumSet as S +import Development.IDE.GHC.Compat as Compat hiding (Cpp) +import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type (Extension (Cpp)) import GhcPlugins (HscEnv (hsc_dflags)) import Ide.PluginUtils (makeDiffTextEdit) @@ -88,12 +87,12 @@ provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable FormatRange (Range (Position sl _) (Position el _)) -> RegionIndices (Just $ sl + 1) (Just $ el + 1) -convertDynFlags :: D.DynFlags -> IO [DynOption] +convertDynFlags :: DynFlags -> IO [DynOption] convertDynFlags df = let pp = ["-pgmF=" <> p | not (null p)] - p = D.sPgm_F $ D.settings df - pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df - ex = map showExtension $ S.toList $ D.extensionFlags df + p = sPgm_F $ Compat.settings df + pm = map (("-fplugin=" <>) . moduleNameString) $ pluginModNames df + ex = map showExtension $ S.toList $ extensionFlags df showExtension = \case Cpp -> "-XCPP" x -> "-X" ++ show x diff --git a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs index 554dea0836..fa32279b3e 100644 --- a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs +++ b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs @@ -91,7 +91,9 @@ genForSig = GenComments {..} isFresh Ann {annsDP} = null [() | (AnnComment _, _) <- annsDP] collectKeys = keyFromTyVar 0 -#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) + comment = mkComment "-- ^ " (spanAsAnchor noSrcSpan) +#elif MIN_VERSION_ghc(9,0,0) comment = mkComment "-- ^ " badRealSrcSpan #else comment = mkComment "-- ^ " noSrcSpan @@ -114,7 +116,9 @@ genForRecord = GenComments {..} collectKeys = keyFromCon -#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) + comment = mkComment "-- | " (spanAsAnchor noSrcSpan) +#elif MIN_VERSION_ghc(9,0,0) comment = mkComment "-- | " badRealSrcSpan #else comment = mkComment "-- | " noSrcSpan @@ -140,7 +144,7 @@ toAction title uri edit = CodeAction {..} toRange :: SrcSpan -> Maybe Range toRange src - | (OldRealSrcSpan s) <- src, + | (RealSrcSpan s _) <- src, range' <- realSrcSpanToRange s = Just range' | otherwise = Nothing diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 9c775c846e..aa148014be 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -10,6 +10,8 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} #ifdef HLINT_ON_GHC_LIB @@ -51,15 +53,18 @@ import Refact.Apply #ifdef HLINT_ON_GHC_LIB import Data.List (nub) -import "ghc" DynFlags as RealGHC.DynFlags (topDir) -import qualified "ghc" EnumSet as EnumSet -import "ghc" GHC as RealGHC (DynFlags (..)) +import Development.IDE.GHC.Compat.Core (BufSpan, + DynFlags, + extensionFlags, + ms_hspp_opts, + topDir) +import qualified Development.IDE.GHC.Compat.Util as EnumSet import "ghc-lib" GHC hiding (DynFlags (..), + RealSrcSpan, ms_hspp_opts) +import qualified "ghc-lib" GHC import "ghc-lib-parser" GHC.LanguageExtensions (Extension) -import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags, - ms_hspp_opts) import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension) import System.FilePath (takeFileName) import System.IO (IOMode (WriteMode), @@ -72,9 +77,7 @@ import System.IO (IOMode (Wri withFile) import System.IO.Temp #else -import Development.IDE.GHC.Compat hiding - (DynFlags (..), - OldRealSrcSpan) +import Development.IDE.GHC.Compat.Core import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions) import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) import Language.Haskell.GHC.ExactPrint.Types (Rigidity (..)) @@ -105,14 +108,16 @@ import System.Environment (setEnv, unsetEnv) -- --------------------------------------------------------------------- +#ifdef HLINT_ON_GHC_LIB -- Reimplementing this, since the one in Development.IDE.GHC.Compat isn't for ghc-lib -pattern OldRealSrcSpan :: RealSrcSpan -> SrcSpan -#if MIN_GHC_API_VERSION(9,0,0) -pattern OldRealSrcSpan span <- RealSrcSpan span _ +pattern RealSrcSpan :: GHC.RealSrcSpan -> Maybe BufSpan -> GHC.SrcSpan +#if MIN_VERSION_ghc(9,0,0) +pattern RealSrcSpan x y = GHC.RealSrcSpan x y #else -pattern OldRealSrcSpan span <- RealSrcSpan span +pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y)) +#endif +{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-} #endif -{-# COMPLETE OldRealSrcSpan, UnhelpfulSpan #-} descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) @@ -209,7 +214,7 @@ rules plugin = do -- This one is defined in Development.IDE.GHC.Error but here -- the types could come from ghc-lib or ghc srcSpanToRange :: SrcSpan -> LSP.Range - srcSpanToRange (OldRealSrcSpan span) = Range { + srcSpanToRange (RealSrcSpan span _) = Range { _start = LSP.Position { _line = srcSpanStartLine span - 1 , _character = srcSpanStartCol span - 1} @@ -482,7 +487,7 @@ applyHint ide nfp mhint = ideaPos = (srcSpanStartLine &&& srcSpanStartCol) . toRealSrcSpan . ideaSpan in filter (\i -> ideaHint i == title' && ideaPos i == (l+1, c+1)) ideas - toRealSrcSpan (OldRealSrcSpan real) = real + toRealSrcSpan (RealSrcSpan real _) = real toRealSrcSpan (UnhelpfulSpan x) = error $ "No real source span: " ++ show x showParseError :: Hlint.ParseError -> String diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 48bf577fbf..9635538101 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -32,7 +32,7 @@ import Development.IDE (GetParsedModule (GetParsedModule), uriToFilePath', use, use_) import Development.IDE.GHC.Compat (GenLocated (L), getSessionDynFlags, hsmodName, importPaths, - pattern OldRealSrcSpan, + pattern RealSrcSpan, pm_parsed_source, unLoc) import Ide.Types import Language.LSP.Server @@ -132,7 +132,7 @@ pathModuleName state normFilePath filePath codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, T.Text)) codeModuleName state nfp = runMaybeT $ do pm <- MaybeT . runAction "ModuleName.GetParsedModule" state $ use GetParsedModule nfp - L (OldRealSrcSpan l) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm + L (RealSrcSpan l _) m <- MaybeT . pure . hsmodName . unLoc $ pm_parsed_source pm pure (realSrcSpanToRange l, T.pack $ show m) -- traceAs :: Show a => String -> a -> a diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs index 4a19566f87..d1a465eb64 100644 --- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs +++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs @@ -7,21 +7,20 @@ module Ide.Plugin.Ormolu ) where -import Control.Exception (try) -import Control.Monad.IO.Class (liftIO) -import qualified Data.Text as T -import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat (moduleNameString) -import qualified DynFlags as D -import qualified EnumSet as S +import Control.Exception (try) +import Control.Monad.IO.Class (liftIO) +import qualified Data.Text as T +import Development.IDE hiding (pluginHandlers) +import Development.IDE.GHC.Compat (moduleNameString, hsc_dflags) +import qualified Development.IDE.GHC.Compat as D +import qualified Development.IDE.GHC.Compat.Util as S import GHC.LanguageExtensions.Type -import GhcPlugins (HscEnv (hsc_dflags)) import Ide.PluginUtils import Ide.Types -import Language.LSP.Server hiding (defaultConfig) +import Language.LSP.Server hiding (defaultConfig) import Language.LSP.Types import Ormolu -import System.FilePath (takeFileName) +import System.FilePath (takeFileName) -- --------------------------------------------------------------------- diff --git a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs index 283f569fdb..c91b61634f 100644 --- a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs +++ b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs @@ -9,9 +9,6 @@ module Ide.Plugin.RefineImports (descriptor) where -import Avail (AvailInfo (Avail), - availName, availNames, - availNamesWithSelectors) import Control.Arrow (Arrow (second)) import Control.DeepSeq (rwhnf) import Control.Monad (join) @@ -27,7 +24,8 @@ import qualified Data.Text as T import Data.Traversable (forM) import Development.IDE import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat (AvailInfo, +import Development.IDE.GHC.Compat + {- (AvailInfo, GenLocated (L), GhcRn, HsModule (hsmodImports), ImportDecl (ImportDecl, ideclHiding, ideclName), @@ -35,9 +33,10 @@ import Development.IDE.GHC.Compat (AvailInfo, Module (moduleName), ModuleName, ParsedModule (ParsedModule, pm_parsed_source), - SrcSpan (RealSrcSpan), + SrcSpan(..), + RealSrcSpan(..), getLoc, ieName, noLoc, - tcg_exports, unLoc) + tcg_exports, unLoc) -} import Development.IDE.Graph.Classes import GHC.Generics (Generic) import Ide.Plugin.ExplicitImports (extractMinimalImports, @@ -46,12 +45,6 @@ import Ide.PluginUtils (mkLspCommand) import Ide.Types import Language.LSP.Server import Language.LSP.Types -import PrelNames (pRELUDE) -import RnNames (findImportUsage, - getMinimalImports) -import TcRnMonad (initTcWithGbl, - tcg_rn_exports, - tcg_used_gres) -- | plugin declaration descriptor :: PluginId -> PluginDescriptor IdeState @@ -257,7 +250,7 @@ refineImportsRule = define $ \RefineImports nfp -> do mkExplicitEdit :: PositionMapping -> LImportDecl pass -> T.Text -> Maybe TextEdit mkExplicitEdit posMapping (L src imp) explicit - | RealSrcSpan l <- src, + | RealSrcSpan l _ <- src, L _ mn <- ideclName imp, -- (almost) no one wants to see an refine import list for Prelude mn /= moduleName pRELUDE, diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index dca7a66346..dee36366cd 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -125,7 +125,7 @@ refsAtName state nfp name = do True (nameOccName name) (Just $ moduleName mod) - (Just $ moduleUnitId mod) + (Just $ moduleUnit mod) [fromNormalizedFilePath nfp] pure $ nubOrd $ astRefs ++ dbRefs diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index cf41005407..eeb70b21d0 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -68,17 +68,17 @@ import Development.IDE.GHC.Compat (GenLocated (L), GhcRn, parseModule, pattern IsBoot, pattern NotBoot, - pattern OldRealSrcSpan, - rds_rules, srcSpanFile) -import GHC.Generics (Generic) -import GhcPlugins (Outputable, - SourceText (NoSourceText), - hm_iface, isQual, - isQual_maybe, + pattern RealSrcSpan, + rds_rules, srcSpanFile, + nameRdrName, occNameString, + rdrNameOcc, occNameFS, nameModule_maybe, - nameRdrName, occNameFS, - occNameString, - rdrNameOcc, unpackFS) + isQual, isQual_maybe, + hm_iface, SourceText(..)) +import Development.IDE.GHC.Compat.Util hiding (try, catch) +import Development.IDE.GHC.Compat.Outputable(Outputable) +import qualified GHC (parseModule) +import GHC.Generics (Generic) import Ide.PluginUtils import Ide.Types import Language.LSP.Server (LspM, @@ -106,7 +106,6 @@ import Retrie.Replace (Change (..), import Retrie.Rewrites import Retrie.SYB (listify) import Retrie.Util (Verbosity (Loud)) -import StringBuffer (stringToStringBuffer) import System.Directory (makeAbsolute) descriptor :: PluginId -> PluginDescriptor IdeState @@ -374,7 +373,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do } logPriority (ideLogger state) Info $ T.pack $ "Parsing module: " <> t parsed <- - evalGhcEnv session (parseModule ms') + evalGhcEnv session (GHC.parseModule ms') `catch` \e -> throwIO (GHCParseError nt (show @SomeException e)) (fixities, parsed) <- fixFixities f (fixAnns parsed) return (fixities, parsed) @@ -473,7 +472,7 @@ asTextEdits NoChange = [] asTextEdits (Change reps _imports) = [ (filePathToUri spanLoc, edit) | Replacement {..} <- nubOrdOn (realSpan . replLocation) reps, - (OldRealSrcSpan rspan) <- [replLocation], + (RealSrcSpan rspan _) <- [replLocation], let spanLoc = unpackFS $ srcSpanFile rspan, let edit = TextEdit (realSrcSpanToRange rspan) (T.pack replReplacement) ] diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 885b8ac72e..0d1beed8f7 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -23,6 +23,7 @@ where import Control.Applicative (Alternative ((<|>))) import Control.Arrow +import Control.Exception import qualified Control.Foldl as L import Control.Lens (Identity (..), ix, view, (%~), (<&>), (^.)) @@ -43,12 +44,11 @@ import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Text as T import Development.IDE -import Development.IDE.GHC.Compat hiding (getLoc) +import Development.IDE.GHC.Compat as Compat hiding (getLoc) +import Development.IDE.GHC.Compat.Outputable +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint -import Exception import GHC.Exts -import GhcMonad -import GhcPlugins hiding (Var, getLoc, (<>)) import Ide.Plugin.Splice.Types import Ide.Types import Language.Haskell.GHC.ExactPrint (setPrecedingLines, @@ -57,8 +57,6 @@ import Language.LSP.Server import Language.LSP.Types import Language.LSP.Types.Capabilities import qualified Language.LSP.Types.Lens as J -import RnSplice -import TcRnMonad descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = @@ -146,7 +144,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do dflags clientCapabilities uri - (graft (RealSrcSpan spliceSpan) expanded) + (graft (RealSrcSpan spliceSpan Nothing) expanded) ps maybe (throwE "No splice information found") (either throwE pure) $ case spliceContext of @@ -162,7 +160,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do dflags clientCapabilities uri - (graftDecls (RealSrcSpan spliceSpan) expanded) + (graftDecls (RealSrcSpan spliceSpan Nothing) expanded) ps <&> -- FIXME: Why ghc-exactprint sweeps preceeding comments? @@ -195,7 +193,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do where range = realSrcSpanToRange spliceSpan - srcSpan = RealSrcSpan spliceSpan + srcSpan = RealSrcSpan spliceSpan Nothing setupHscEnv @@ -217,27 +215,22 @@ setupHscEnv ideState fp pm = do setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags setupDynFlagsForGHCiLike env dflags = do - let dflags3 = - dflags - { hscTarget = HscInterpreted - , ghcMode = CompManager - , ghcLink = LinkInMemory - } + let dflags3 = setInterpreterLinkerOptions dflags platform = targetPlatform dflags3 - dflags3a = updateWays $ dflags3 {ways = interpWays} + dflags3a = setWays hostFullWays dflags3 dflags3b = foldl gopt_set dflags3a $ - concatMap (wayGeneralFlags platform) interpWays + concatMap (wayGeneralFlags platform) hostFullWays dflags3c = foldl gopt_unset dflags3b $ - concatMap (wayUnsetGeneralFlags platform) interpWays + concatMap (wayUnsetGeneralFlags platform) hostFullWays dflags4 = dflags3c `gopt_set` Opt_ImplicitImportQualified `gopt_set` Opt_IgnoreOptimChanges `gopt_set` Opt_IgnoreHpcChanges `gopt_unset` Opt_DiagnosticsShowCaret - initializePlugins env dflags4 + hsc_dflags <$> initializePlugins (hscSetFlags dflags4 env) adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit adjustToRange uri ran (WorkspaceEdit mhult mlt x) = @@ -335,26 +328,26 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e case classifyAST spliceContext of IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $ flip (transformM dflags clientCapabilities uri) ps $ - graftDeclsWithM (RealSrcSpan srcSpan) $ \case + graftDeclsWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (SpliceD _ (SpliceDecl _ (L _ spl) _))) -> do eExpr <- eitherM (fail . show) pure $ lift ( lift $ - gtry @_ @SomeException $ + Util.try @_ @SomeException $ (fst <$> rnTopSpliceDecls spl) ) pure $ Just eExpr _ -> pure Nothing OneToOneAST astP -> flip (transformM dflags clientCapabilities uri) ps $ - graftWithM (RealSrcSpan srcSpan) $ \case + graftWithM (RealSrcSpan srcSpan Nothing) $ \case (L _spn (matchSplice astP -> Just spl)) -> do eExpr <- eitherM (fail . show) pure $ lift ( lift $ - gtry @_ @SomeException $ + Util.try @_ @SomeException $ (fst <$> expandSplice astP spl) ) Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr @@ -428,8 +421,8 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ mkQ Continue ( \case - (L l@(RealSrcSpan spLoc) expr :: LHsExpr GhcPs) - | RealSrcSpan spn `isSubspanOf` l -> + (L l@(RealSrcSpan spLoc _) expr :: LHsExpr GhcPs) + | RealSrcSpan spn Nothing `isSubspanOf` l -> case expr of HsSpliceE {} -> Here (spLoc, Expr) _ -> Continue @@ -437,25 +430,25 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ ) `extQ` \case #if __GLASGOW_HASKELL__ == 808 - (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc) pat :: Located (Pat GhcPs)) + (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs)) #else - (L l@(RealSrcSpan spLoc) pat :: LPat GhcPs) + (L l@(RealSrcSpan spLoc _) pat :: LPat GhcPs) #endif - | RealSrcSpan spn `isSubspanOf` l -> + | RealSrcSpan spn Nothing `isSubspanOf` l -> case pat of SplicePat{} -> Here (spLoc, Pat) _ -> Continue _ -> Stop `extQ` \case - (L l@(RealSrcSpan spLoc) ty :: LHsType GhcPs) - | RealSrcSpan spn `isSubspanOf` l -> + (L l@(RealSrcSpan spLoc _) ty :: LHsType GhcPs) + | RealSrcSpan spn Nothing `isSubspanOf` l -> case ty of HsSpliceTy {} -> Here (spLoc, HsType) _ -> Continue _ -> Stop `extQ` \case - (L l@(RealSrcSpan spLoc) decl :: LHsDecl GhcPs) - | RealSrcSpan spn `isSubspanOf` l -> + (L l@(RealSrcSpan spLoc _) decl :: LHsDecl GhcPs) + | RealSrcSpan spn Nothing `isSubspanOf` l -> case decl of SpliceD {} -> Here (spLoc, HsDecl) _ -> Continue diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs index 9082c2b634..071341b36b 100644 --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -9,9 +9,8 @@ import Control.Monad.IO.Class import Data.Text (Text) import qualified Data.Text as T import Development.IDE hiding (pluginHandlers) -import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts)) -import qualified DynFlags as D -import qualified EnumSet as ES +import Development.IDE.GHC.Compat (ModSummary (ms_hspp_opts), extensionFlags) +import qualified Development.IDE.GHC.Compat.Util as Util import GHC.LanguageExtensions.Type import Ide.PluginUtils import Ide.Types @@ -52,7 +51,7 @@ provider ide typ contents fp _opts = do | otherwise = pure config - getExtensions = map showExtension . ES.toList . D.extensionFlags + getExtensions = map showExtension . Util.toList . extensionFlags showExtension Cpp = "CPP" showExtension other = show other diff --git a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs index 89769ae8aa..c993f60a6c 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs @@ -16,8 +16,6 @@ import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat import Development.IDE.GHC.ExactPrint import Generics.SYB.GHC (mkBindListT, everywhereM') -import GhcPlugins (occName) -import System.Timeout (timeout) import Wingman.AbstractLSP.Types import Wingman.CaseSplit import Wingman.GHC (liftMaybe, isHole, pattern AMatch, unXPat) @@ -76,7 +74,7 @@ makeTacticInteraction cmd = $ addTimeoutMessage rtr $ pure $ GraftEdit - $ graftHole (RealSrcSpan $ unTrack pm_span) rtr + $ graftHole (RealSrcSpan (unTrack pm_span) Nothing) rtr addTimeoutMessage :: RunTacticResults -> [ContinuationResult] -> [ContinuationResult] diff --git a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs index e93af82e50..180229cf02 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs @@ -12,7 +12,6 @@ import qualified Data.Set as S import Development.IDE.GHC.Compat import GHC.Exts (IsString (fromString)) import GHC.SourceGen (funBindsWithFixity, match, wildP) -import OccName import Wingman.GHC import Wingman.Types diff --git a/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs index 07b112e01a..5f2f86605c 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs @@ -10,7 +10,6 @@ module Wingman.CodeGen ) where -import ConLike import Control.Lens ((%~), (<>~), (&)) import Control.Monad.Except import Control.Monad.Reader (ask) @@ -22,7 +21,6 @@ import Data.Generics.Labels () import Data.List import qualified Data.Set as S import Data.Traversable -import DataCon import Development.IDE.GHC.Compat import GHC.Exts import GHC.SourceGen (occNameToStr) @@ -30,11 +28,6 @@ import GHC.SourceGen.Binds import GHC.SourceGen.Expr import GHC.SourceGen.Overloaded import GHC.SourceGen.Pat -import GhcPlugins (isSymOcc, mkVarOccFS) -import OccName (occName) -import PatSyn -import Type hiding (Var) -import TysPrim (alphaTy) import Wingman.CodeGen.Utils import Wingman.GHC import Wingman.Judgements @@ -202,7 +195,7 @@ conLikeInstOrigArgTys' con uniTys = conLikeExTys :: ConLike -> [TyCoVar] -conLikeExTys (RealDataCon d) = dataConExTys d +conLikeExTys (RealDataCon d) = dataConExTyCoVars d conLikeExTys (PatSynCon p) = patSynExTys p patSynExTys :: PatSyn -> [TyCoVar] diff --git a/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs index 1f1738dacc..d683db9ffd 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs @@ -1,14 +1,10 @@ module Wingman.CodeGen.Utils where -import ConLike (ConLike(RealDataCon), conLikeName) +import Data.String import Data.List -import DataCon import Development.IDE.GHC.Compat -import GHC.Exts import GHC.SourceGen (RdrNameStr (UnqualStr), recordConE, string) -import GHC.SourceGen.Overloaded -import GhcPlugins (nilDataCon, charTy, eqType) -import Name +import GHC.SourceGen.Overloaded as SourceGen import Wingman.GHC (getRecordFields) @@ -48,7 +44,7 @@ coerceName = UnqualStr . fromString . occNameString . occName ------------------------------------------------------------------------------ -- | Like 'var', but works over standard GHC 'OccName's. -var' :: Var a => OccName -> a +var' :: SourceGen.Var a => OccName -> a var' = var . fromString . occNameString diff --git a/plugins/hls-tactics-plugin/src/Wingman/Context.hs b/plugins/hls-tactics-plugin/src/Wingman/Context.hs index 0cfd6488d6..9aea0bf5eb 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Context.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Context.hs @@ -1,6 +1,5 @@ module Wingman.Context where -import Bag import Control.Arrow import Control.Monad.Reader import Data.Coerce (coerce) @@ -8,12 +7,7 @@ import Data.Foldable.Extra (allM) import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Set as S import Development.IDE.GHC.Compat -import GhcPlugins (ExternalPackageState (eps_inst_env), piResultTys, eps_fam_inst_env, extractModule) -import InstEnv (lookupInstEnv, InstEnvs(..), is_dfun) -import OccName -import TcRnTypes -import TcType (tcSplitTyConApp, tcSplitPhiTy) -import TysPrim (alphaTys) +import Development.IDE.GHC.Compat.Util import Wingman.GHC (normalizeType) import Wingman.Judgements.Theta import Wingman.Types diff --git a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs index 7db728b9ab..72b001d3ce 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs @@ -17,8 +17,7 @@ module Wingman.Debug import Control.DeepSeq import Control.Exception import Debug.Trace -import DynFlags (unsafeGlobalDynFlags) -import Outputable hiding ((<>)) +import Development.IDE.GHC.Compat.Outputable import System.IO.Unsafe (unsafePerformIO) #if __GLASGOW_HASKELL__ >= 808 @@ -38,7 +37,7 @@ unsafeRender = unsafeRender' . ppr unsafeRender' :: SDoc -> String unsafeRender' sdoc = unsafePerformIO $ do - let z = showSDoc unsafeGlobalDynFlags sdoc + let z = showSDocUnsafe sdoc -- We might not have unsafeGlobalDynFlags (like during testing), in which -- case GHC panics. Instead of crashing, let's just fail to print. !res <- try @GHC_EXCEPTION $ evaluate $ deepseq z z diff --git a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs index 93deee4e3a..8d2bd69725 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs @@ -28,10 +28,7 @@ import Development.IDE.Spans.LocalBindings (getLocalScope) import Ide.Types import Language.LSP.Server import Language.LSP.Types -import OccName import Prelude hiding (span) -import Prelude hiding (span) -import TcRnTypes (tcg_binds) import Wingman.AbstractLSP.Types import Wingman.CodeGen (destructionFor) import Wingman.GHC @@ -73,7 +70,7 @@ emptyCaseInteraction = Interaction $ ty edits <- liftMaybe $ hush $ mkWorkspaceEdits le_dflags ccs fc_uri (unTrack pm) $ - graftMatchGroup (RealSrcSpan $ unTrack ss) $ + graftMatchGroup (RealSrcSpan (unTrack ss) Nothing) $ noLoc matches pure ( range @@ -153,7 +150,7 @@ emptyCaseScrutinees state nfp = do True -> pure empty False -> case ss of - RealSrcSpan r -> do + RealSrcSpan r _ -> do rss' <- liftMaybe $ mapAgeTo tcg_map $ unsafeCopyAge aged r pure $ Just (rss', ty) UnhelpfulSpan _ -> empty diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index 43eb2cfa6a..890962e009 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -3,12 +3,8 @@ module Wingman.GHC where -import Bag (bagToList) -import Class (classTyVars) -import ConLike import Control.Monad.State import Control.Monad.Trans.Maybe (MaybeT(..)) -import CoreUtils (exprType) import Data.Bool (bool) import Data.Function (on) import Data.Functor ((<&>)) @@ -18,24 +14,11 @@ import Data.Maybe (isJust) import Data.Set (Set) import qualified Data.Set as S import Data.Traversable -import DataCon -import Development.IDE.GHC.Compat hiding (exprType) -import DsExpr (dsExpr) -import DsMonad (initDs) -import FamInst (tcLookupDataFamInst_maybe) -import FamInstEnv (normaliseType) +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Util import GHC.SourceGen (lambda) import Generics.SYB (Data, everything, everywhere, listify, mkQ, mkT) -import GhcPlugins (Role (Nominal)) -import OccName -import TcRnMonad -import TcType -import TyCoRep -import Type -import TysWiredIn (charTyCon, doubleTyCon, floatTyCon, intTyCon) import Unify -import Unique -import Var import Wingman.StaticPlugin (pattern MetaprogramSyntax) import Wingman.Types @@ -61,8 +44,8 @@ instantiateType t = do cloneTyVar :: TyVar -> TyVar cloneTyVar t = let uniq = getUnique t - some_magic_number = 49 - in setVarUnique t $ deriveUnique uniq some_magic_number + some_magic_char = 'w' -- 'w' for wingman ;D + in setVarUnique t $ newTagUnique uniq some_magic_char ------------------------------------------------------------------------------ @@ -322,15 +305,6 @@ pattern TopLevelRHS name ps body where_binds <- (GRHSs _ [L _ (GRHS _ [] body)] (L _ where_binds)) - -dataConExTys :: DataCon -> [TyCoVar] -#if __GLASGOW_HASKELL__ >= 808 -dataConExTys = DataCon.dataConExTyCoVars -#else -dataConExTys = DataCon.dataConExTyVars -#endif - - ------------------------------------------------------------------------------ -- | In GHC 8.8, sometimes patterns are wrapped in 'XPat'. -- The nitty gritty details are explained at @@ -354,16 +328,6 @@ liftMaybe a = MaybeT $ pure a typeCheck :: HscEnv -> TcGblEnv -> HsExpr GhcTc -> IO (Maybe Type) typeCheck hscenv tcg = fmap snd . initDs hscenv tcg . fmap exprType . dsExpr - -mkFunTys' :: [Type] -> Type -> Type -mkFunTys' = -#if __GLASGOW_HASKELL__ <= 808 - mkFunTys -#else - mkVisFunTys -#endif - - ------------------------------------------------------------------------------ -- | Expand type and data families normalizeType :: Context -> Type -> Type diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 21c1e609a8..2900c944c1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -1,6 +1,5 @@ module Wingman.Judgements where -import ConLike (ConLike) import Control.Arrow import Control.Lens hiding (Context) import Data.Bool @@ -13,10 +12,8 @@ import Data.Maybe import Data.Set (Set) import qualified Data.Set as S import Development.IDE.Core.UseStale (Tracked, unTrack) +import Development.IDE.GHC.Compat import Development.IDE.Spans.LocalBindings -import OccName -import SrcLoc -import Type import Wingman.GHC (algebraicTyCon, normalizeType) import Wingman.Judgements.Theta import Wingman.Types diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs index 0365e5e392..ba3bba4378 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements/SYB.hs @@ -8,8 +8,8 @@ import Data.Foldable (foldl') import Data.Generics hiding (typeRep) import qualified Data.Text as T import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Util (unpackFS) import GHC.Exts (Any) -import GhcPlugins (unpackFS) import Type.Reflection import Unsafe.Coerce (unsafeCoerce) import Wingman.StaticPlugin (pattern WingmanMetaprogram) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs index 21b16edbc4..641765015f 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs @@ -12,7 +12,6 @@ module Wingman.Judgements.Theta , allEvidenceToSubst ) where -import Class (classTyVars) import Control.Applicative (empty) import Control.Lens (preview) import Data.Coerce (coerce) @@ -24,17 +23,6 @@ import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat import Generics.SYB hiding (tyConName, empty, Generic) import GHC.Generics -import GhcPlugins (mkVarOcc, splitTyConApp_maybe, getTyVar_maybe, zipTvSubst, unionTCvSubst, emptyTCvSubst, TCvSubst) -#if __GLASGOW_HASKELL__ > 806 -import GhcPlugins (eqTyCon) -#else -import GhcPlugins (nameRdrName, tyConName) -import PrelNames (eqTyCon_RDR) -#endif -import TcEvidence -import TcType (substTy) -import TcType (tcTyConAppTyCon_maybe) -import TysPrim (eqPrimTyCon) import Wingman.GHC import Wingman.Types diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs index 5158ce4fc8..c5df1c80c1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs @@ -1,7 +1,7 @@ module Wingman.KnownStrategies where import Data.Foldable (for_) -import OccName (mkVarOcc, mkClsOcc) +import Development.IDE.GHC.Compat.Core import Refinery.Tactic import Wingman.Judgements (jGoal) import Wingman.KnownStrategies.QuickCheck (deriveArbitrary) diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs index f6013af5af..4cc1d4afb8 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs @@ -1,11 +1,9 @@ module Wingman.KnownStrategies.QuickCheck where -import ConLike (ConLike(RealDataCon)) import Data.Bool (bool) import Data.Generics (everything, mkQ) import Data.List (partition) -import DataCon (DataCon, dataConName) -import Development.IDE.GHC.Compat (GhcPs, HsExpr, noLoc) +import Development.IDE.GHC.Compat import GHC.Exts (IsString (fromString)) import GHC.List (foldl') import GHC.SourceGen (int) @@ -13,10 +11,7 @@ import GHC.SourceGen.Binds (match, valBind) import GHC.SourceGen.Expr (case', lambda, let') import GHC.SourceGen.Overloaded (App ((@@)), HasList (list)) import GHC.SourceGen.Pat (conP) -import OccName (HasOccName (occName), mkVarOcc, occNameString) import Refinery.Tactic (goal, rule, failure) -import TyCon (TyCon, tyConDataCons, tyConName) -import Type (splitTyConApp_maybe) import Wingman.CodeGen import Wingman.Judgements (jGoal) import Wingman.Machinery (tracePrim) diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index 10a09bccd9..e96fb61236 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -8,7 +8,6 @@ module Wingman.LanguageServer where -import ConLike import Control.Arrow ((***)) import Control.Monad import Control.Monad.IO.Class @@ -35,16 +34,15 @@ import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (IdeState (..), uses, define, use) import qualified Development.IDE.Core.Shake as IDE import Development.IDE.Core.UseStale -import Development.IDE.GHC.Compat hiding (parseExpr) +import Development.IDE.GHC.Compat +import qualified Development.IDE.GHC.Compat.Util as FastString import Development.IDE.GHC.Error (realSrcSpanToRange) import Development.IDE.GHC.ExactPrint import Development.IDE.Graph (Action, RuleResult, Rules, action) import Development.IDE.Graph.Classes (Binary, Hashable, NFData) import Development.IDE.Spans.LocalBindings (Bindings, getDefiningBindings) -import qualified FastString import GHC.Generics (Generic) import Generics.SYB hiding (Generic) -import GhcPlugins (tupleDataCon, consDataCon, substTyAddInScope, ExternalPackageState, HscEnv (hsc_EPS), unpackFS) import qualified Ide.Plugin.Config as Plugin import Ide.Plugin.Properties import Ide.PluginUtils (usePropertyLsp) @@ -57,11 +55,8 @@ import Language.LSP.Types hiding SemanticTokenRelative (length), SemanticTokensEdit (_start)) import Language.LSP.Types.Capabilities -import OccName import Prelude hiding (span) import Retrie (transformA) -import SrcLoc (containsSpan) -import TcRnTypes (tcg_binds, TcGblEnv) import Wingman.Context import Wingman.GHC import Wingman.Judgements @@ -183,7 +178,7 @@ getIdeDynflags state nfp = do getAllMetaprograms :: Data a => a -> [String] getAllMetaprograms = everything (<>) $ mkQ mempty $ \case - WingmanMetaprogram fs -> [ unpackFS fs ] + WingmanMetaprogram fs -> [ FastString.unpackFS fs ] (_ :: HsExpr GhcTc) -> mempty @@ -222,7 +217,7 @@ judgementForHole state nfp range cfg = do eps <- liftIO $ readIORef $ hsc_EPS $ hscEnv henv (jdg, ctx) <- liftMaybe $ mkJudgementAndContext cfg g binds new_rss tcg (hscEnv henv) eps - let mp = getMetaprogramAtSpan (fmap RealSrcSpan tcg_rss) tcg_t + let mp = getMetaprogramAtSpan (fmap (`RealSrcSpan` Nothing) tcg_rss) tcg_t dflags <- getIdeDynflags state nfp pure $ HoleJudgment @@ -261,10 +256,10 @@ mkJudgementAndContext cfg g (TrackedStale binds bmap) rss (TrackedStale tcg tcgm eps evidence top_provs = getRhsPosVals tcg_rss tcs - already_destructed = getAlreadyDestructed (fmap RealSrcSpan tcg_rss) tcs + already_destructed = getAlreadyDestructed (fmap (`RealSrcSpan` Nothing) tcg_rss) tcs local_hy = spliceProvenance top_provs $ hypothesisFromBindings binds_rss binds - evidence = getEvidenceAtHole (fmap RealSrcSpan tcg_rss) tcs + evidence = getEvidenceAtHole (fmap (`RealSrcSpan` Nothing) tcg_rss) tcs cls_hy = foldMap evidenceToHypothesis evidence subst = ts_unifier $ evidenceToSubst evidence defaultTacticState pure $ @@ -339,7 +334,7 @@ getRhsPosVals getRhsPosVals (unTrack -> rss) (unTrack -> tcs) = everything (<>) (mkQ mempty $ \case TopLevelRHS name ps - (L (RealSrcSpan span) -- body with no guards and a single defn + (L (RealSrcSpan span _) -- body with no guards and a single defn (HsVar _ (L _ hole))) _ | containsSpan rss span -- which contains our span @@ -495,7 +490,7 @@ isRhsHoleWithoutWhere isRhsHoleWithoutWhere (unTrack -> rss) (unTrack -> tcs) = everything (||) (mkQ False $ \case TopLevelRHS _ _ - (L (RealSrcSpan span) _) + (L (RealSrcSpan span _) _) (EmptyLocalBinds _) -> containsSpan rss span _ -> False ) tcs diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs index 915724f1aa..3fd853bc31 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs @@ -22,12 +22,9 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake (IdeState (..)) import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat -import GhcPlugins (containsSpan, realSrcLocSpan, realSrcSpanStart) import Ide.Types import Language.LSP.Types import Prelude hiding (span) -import Prelude hiding (span) -import TcRnTypes (tcg_binds) import Wingman.GHC import Wingman.Judgements.SYB (metaprogramQ) import Wingman.LanguageServer @@ -44,7 +41,7 @@ hoverProvider state plId (HoverParams (TextDocumentIdentifier uri) (unsafeMkCurr cfg <- getTacticConfig plId liftIO $ fromMaybeT (Right Nothing) $ do - holes <- getMetaprogramsAtSpan state nfp $ RealSrcSpan $ unTrack loc + holes <- getMetaprogramsAtSpan state nfp $ RealSrcSpan (unTrack loc) Nothing fmap (Right . Just) $ case (find (flip containsSpan (unTrack loc) . unTrack . fst) holes) of @@ -80,7 +77,7 @@ getMetaprogramsAtSpan state nfp ss = do let scrutinees = traverse (metaprogramQ ss . tcg_binds) tcg for scrutinees $ \aged@(unTrack -> (ss, program)) -> do case ss of - RealSrcSpan r -> do + RealSrcSpan r _ -> do rss' <- liftMaybe $ mapAgeTo tcg_map $ unsafeCopyAge aged r pure (rss', program) UnhelpfulSpan _ -> empty diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs index 5a0844b73c..631baf58b7 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs @@ -16,12 +16,10 @@ import Data.Maybe import Data.Monoid import qualified Data.Set as S import qualified Data.Text as T -import DataCon (dataConName) import Development.IDE.GHC.Compat import GHC.LanguageExtensions.Type (Extension (LambdaCase)) import Ide.Types import Language.LSP.Types hiding (SemanticTokenAbsolute (..), SemanticTokenRelative (..)) -import OccName import Prelude hiding (span) import Wingman.AbstractLSP.Types import Wingman.Auto diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index 9a369cdd0a..f540a4a741 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -25,15 +25,11 @@ import qualified Data.Set as S import Data.Traversable (for) import Development.IDE.Core.Compile (lookupName) import Development.IDE.GHC.Compat -import GhcPlugins (GlobalRdrElt (gre_name), lookupOccEnv, varType) import Refinery.Future import Refinery.ProofState import Refinery.Tactic import Refinery.Tactic.Internal import System.Timeout (timeout) -import TcType -import Type (tyCoVarsOfTypeWellScoped) -import TysPrim (alphaTyVar, alphaTy) import Wingman.Context (getInstance) import Wingman.GHC (tryUnifyUnivarsButNotSkolems, updateSubst, tacticsGetDataCons, freshTyvars) import Wingman.Judgements @@ -235,7 +231,7 @@ newtype Reward a = Reward a newUnivar :: MonadState TacticState m => m Type newUnivar = do freshTyvars $ - mkInvForAllTys [alphaTyVar] alphaTy + mkInfForAllTys [alphaTyVar] alphaTy ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs index 2c15cee171..a9bdb694d1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Lexer.hs @@ -11,7 +11,7 @@ import Data.Foldable (asum) import Data.Text (Text) import qualified Data.Text as T import Data.Void -import Name +import Development.IDE.GHC.Compat.Core (OccName, mkVarOcc) import qualified Text.Megaparsec as P import qualified Text.Megaparsec.Char as P import qualified Text.Megaparsec.Char.Lexer as L diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs index c16b9dca70..96c93da2d1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser.hs @@ -11,7 +11,7 @@ import Data.Functor import Data.Maybe (listToMaybe) import qualified Data.Text as T import Development.IDE.GHC.Compat (RealSrcLoc, srcLocLine, srcLocCol, srcLocFile) -import FastString (unpackFS) +import Development.IDE.GHC.Compat.Util (unpackFS) import Refinery.Tactic (failure) import qualified Refinery.Tactic as R import qualified Text.Megaparsec as P diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs index 51416ecd21..69ed1d9a96 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs @@ -14,13 +14,8 @@ import Data.Monoid import Data.Set (Set) import qualified Data.Set as S import Data.Traversable -import GhcPlugins (charTy, maybeTyCon) -import Name -import TcType +import Development.IDE.GHC.Compat.Core import Text.Hyphenation (hyphenate, english_US) -import TyCon -import Type -import TysWiredIn (listTyCon, unitTyCon) import Wingman.GHC (tcTyVar_maybe) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Range.hs b/plugins/hls-tactics-plugin/src/Wingman/Range.hs index fed5729996..b7ae845663 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Range.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Range.hs @@ -4,15 +4,16 @@ module Wingman.Range where import Development.IDE hiding (rangeToRealSrcSpan, rangeToSrcSpan) -import qualified FastString as FS -import SrcLoc +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Util as FS + ------------------------------------------------------------------------------ -- | Convert a DAML compiler Range to a GHC SrcSpan -- TODO(sandy): this doesn't belong here rangeToSrcSpan :: String -> Range -> SrcSpan -rangeToSrcSpan file range = RealSrcSpan $ rangeToRealSrcSpan file range +rangeToSrcSpan file range = RealSrcSpan (rangeToRealSrcSpan file range) Nothing rangeToRealSrcSpan :: String -> Range -> RealSrcSpan diff --git a/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs b/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs index 635fa463a5..97ffe53e54 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs @@ -9,12 +9,11 @@ module Wingman.StaticPlugin import Data.Data import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat.Util import GHC.LanguageExtensions.Type (Extension(EmptyCase, QuasiQuotes)) import Generics.SYB -import GhcPlugins hiding ((<>)) import Ide.Types - staticPlugin :: DynFlagsModifications staticPlugin = mempty { dynFlagsModifyGlobal = @@ -63,7 +62,7 @@ metaprogrammingPlugin :: StaticPlugin metaprogrammingPlugin = StaticPlugin $ PluginWithArgs (defaultPlugin { parsedResultAction = worker }) [] where - worker :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule + worker :: Monad m => [CommandLineOption] -> ModSummary -> HsParsedModule -> m HsParsedModule worker _ _ pm = pure $ pm { hpm_module = addMetaprogrammingSyntax $ hpm_module pm } #endif diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index 7971ca4671..fb0545c39d 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -6,7 +6,6 @@ module Wingman.Tactics , runTactic ) where -import ConLike (ConLike(RealDataCon)) import Control.Applicative (Alternative(empty), (<|>)) import Control.Lens ((&), (%~), (<>~)) import Control.Monad (filterM) @@ -18,24 +17,19 @@ import Data.Bool (bool) import Data.Foldable import Data.Functor ((<&>)) import Data.Generics.Labels () +import Data.Traversable (for) import Data.List import Data.List.Extra (dropEnd, takeEnd) import qualified Data.Map as M import Data.Maybe import Data.Set (Set) import qualified Data.Set as S -import Data.Traversable (for) -import DataCon import Development.IDE.GHC.Compat import GHC.Exts import GHC.SourceGen ((@@)) import GHC.SourceGen.Expr -import Name (occNameString, occName) -import OccName (mkVarOcc) import Refinery.Tactic import Refinery.Tactic.Internal -import TcType -import Type hiding (Var) import Wingman.CodeGen import Wingman.GHC import Wingman.Judgements @@ -150,7 +144,7 @@ intros' params = rule $ \jdg -> do bound_occs = fmap fst bindings hy' = lambdaHypothesis top_hole bindings jdg' = introduce ctx hy' - $ withNewGoal (CType $ mkFunTys' (drop num_occs args) res) jdg + $ withNewGoal (CType $ mkVisFunTys (drop num_occs args) res) jdg ext <- newSubgoal jdg' pure $ ext @@ -289,7 +283,7 @@ apply (Unsaturated n) hi = tracing ("apply' " <> show (hi_name hi)) $ do saturated_args = dropEnd n all_args unsaturated_args = takeEnd n all_args rule $ \jdg -> do - unify g (CType $ mkFunTys' unsaturated_args ret) + unify g (CType $ mkVisFunTys unsaturated_args ret) ext <- fmap unzipTrace $ traverse ( newSubgoal @@ -545,7 +539,7 @@ nary :: Int -> TacticsM () nary n = do a <- newUnivar b <- newUnivar - applyByType $ mkFunTys' (replicate n a) b + applyByType $ mkVisFunTys (replicate n a) b self :: TacticsM () @@ -630,7 +624,7 @@ with_arg = rule $ \jdg -> do let g = jGoal jdg fresh_ty <- newUnivar a <- newSubgoal $ withNewGoal (CType fresh_ty) jdg - f <- newSubgoal $ withNewGoal (coerce mkFunTys' [fresh_ty] g) jdg + f <- newSubgoal $ withNewGoal (coerce mkVisFunTys [fresh_ty] g) jdg pure $ fmap noLoc $ (@@) <$> fmap unLoc f <*> fmap unLoc a diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index 491ff9724a..63c30a82ae 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -14,7 +14,6 @@ module Wingman.Types , Span ) where -import ConLike (ConLike) import Control.Lens hiding (Context) import Control.Monad.Reader import Control.Monad.State @@ -33,23 +32,17 @@ import Data.Tree import Development.IDE (Range) import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat hiding (Node) +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Orphans () -import FamInstEnv (FamInstEnvs) import GHC.Exts (fromString) import GHC.Generics import GHC.SourceGen (var) -import GhcPlugins (GlobalRdrElt, mkRdrUnqual) -import InstEnv (InstEnvs(..)) -import OccName import Refinery.ProofState import Refinery.Tactic import Refinery.Tactic.Internal (TacticT(TacticT), RuleT (RuleT)) import System.IO.Unsafe (unsafePerformIO) -import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst) -import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply) -import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique, mkUnique) import Wingman.Debug -import Data.IORef +import Data.IORef ------------------------------------------------------------------------------ @@ -199,7 +192,7 @@ defaultTacticState = ------------------------------------------------------------------------------ -- | Generate a new 'Unique' -freshUnique :: MonadState TacticState m => m Unique +freshUnique :: MonadState TacticState m => m Util.Unique freshUnique = do (uniq, supply) <- gets $ takeUniqFromSupply . ts_unique_gen modify' $! field @"ts_unique_gen" .~ supply @@ -269,11 +262,11 @@ newtype Uniquely a = Uniquely { getViaUnique :: a } deriving Show via a deriving stock (Data, Typeable) -instance Uniquable a => Eq (Uniquely a) where - (==) = (==) `on` getUnique . getViaUnique +instance Util.Uniquable a => Eq (Uniquely a) where + (==) = (==) `on` Util.getUnique . getViaUnique -instance Uniquable a => Ord (Uniquely a) where - compare = nonDetCmpUnique `on` getUnique . getViaUnique +instance Util.Uniquable a => Ord (Uniquely a) where + compare = Util.nonDetCmpUnique `on` Util.getUnique . getViaUnique -- NOTE(sandy): The usage of list here is mostly for convenience, but if it's @@ -349,7 +342,7 @@ instance MonadReader r m => MonadReader r (RuleT jdg ext err s m) where local f (RuleT m) = RuleT $ Effect $ local f $ pure m mkMetaHoleName :: Int -> RdrName -mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show (mkUnique 'w' u) +mkMetaHoleName u = mkRdrUnqual $ mkVarOcc $ "_" <> show (Util.mkUnique 'w' u) instance MetaSubst Int (Synthesized (LHsExpr GhcPs)) where -- TODO(sandy): This join is to combine the synthesizeds From 557cf1bfb15ce2dd9caa2beaec260782efd144ae Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 29 Aug 2021 12:00:24 +0200 Subject: [PATCH 03/22] Fix Hlint warnings --- ghcide/.hlint.yaml | 12 +++++++++++- ghcide/src/Development/IDE/GHC/CPP.hs | 3 --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 1 + 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/ghcide/.hlint.yaml b/ghcide/.hlint.yaml index 2bb82f5a5a..3bdc5d0242 100644 --- a/ghcide/.hlint.yaml +++ b/ghcide/.hlint.yaml @@ -94,6 +94,16 @@ - Development.IDE.Core.Rules - Development.IDE.Core.Tracing - Development.IDE.GHC.Compat + - Development.IDE.GHC.Compat.Core + - Development.IDE.GHC.Compat.Env + - Development.IDE.GHC.Compat.Iface + - Development.IDE.GHC.Compat.Logger + - Development.IDE.GHC.Compat.Outputable + - Development.IDE.GHC.Compat.Parser + - Development.IDE.GHC.Compat.Plugins + - Development.IDE.GHC.Compat.Units + - Development.IDE.GHC.Compat.Util + - Development.IDE.GHC.CPP - Development.IDE.GHC.ExactPrint - Development.IDE.GHC.Orphans - Development.IDE.GHC.Util @@ -112,7 +122,7 @@ - flags: - default: false - {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]} - - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.Benchmark.Rules]} + - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.IDE.GHC.Compat.Core, Development.Benchmark.Rules]} - {name: [-Wno-deprecations, -Wno-unticked-promoted-constructors], within: [Main, Experiments]} # - modules: # - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 307fdea237..ee23fb004b 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -2,10 +2,7 @@ -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE CPP #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- -- diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index eaab329483..19536b19cd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -243,6 +243,7 @@ module Development.IDE.GHC.Compat.Core ( #if MIN_VERSION_ghc(8,8,0) eqTyCon, #endif + eqTyCon_RDR, isTupleTyCon, -- * Class Class(..), From 185d831edd71bce455a8a80afcb3afc7ee6dfbba Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 30 Aug 2021 19:11:11 +0200 Subject: [PATCH 04/22] Enable more plugins for ghc 9.0 --- cabal-ghc901.project | 12 +++--------- cabal-ghc921.project | 15 +-------------- ghcide/src/Control/Concurrent/Strict.hs | 3 ++- 3 files changed, 6 insertions(+), 24 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 4310678a43..1de27de88d 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -6,7 +6,7 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils - -- ./plugins/hls-tactics-plugin + -- ./plugins/hls-tactics-plugin -- ./plugins/hls-brittany-plugin -- ./plugins/hls-stylish-haskell-plugin -- ./plugins/hls-fourmolu-plugin @@ -18,7 +18,7 @@ packages: ./plugins/hls-rename-plugin ./plugins/hls-retrie-plugin ./plugins/hls-haddock-comments-plugin - -- ./plugins/hls-splice-plugin + ./plugins/hls-splice-plugin ./plugins/hls-floskell-plugin ./plugins/hls-pragmas-plugin ./plugins/hls-module-name-plugin @@ -39,12 +39,6 @@ source-repository-package tag: b6245884ae83e00dd2b5261762549b37390179f8 -- https://github.com/lspitzner/czipwith/pull/2 --- Head of hie-bios -source-repository-package - type: git - location: https://github.com/mpickering/hie-bios - tag: 1875bff093983a0506f80e214eda27e7419da3bc - -- Head of hiedb source-repository-package type: git @@ -77,7 +71,7 @@ index-state: 2021-09-06T12:12:22Z constraints: -- These plugins doesn't work on GHC9 yet - haskell-language-server -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports + haskell-language-server -brittany -class -fourmolu -stylishhaskell -tactic allow-newer: floskell:base, diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 1941b23274..2798109295 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -30,13 +30,6 @@ package * ghc-options: -haddock test-show-details: direct -source-repository-package - type: git - location: https://github.com/jwaldmann/blaze-textual.git - tag: d8ee6cf80e27f9619d621c936bb4bda4b99a183f - -- https://github.com/jwaldmann/blaze-textual/commit/d8ee6cf80e27f9619d621c936bb4bda4b99a183f - -- https://github.com/bos/blaze-textual/issues/13 - source-repository-package type: git location: https://github.com/mithrandi/czipwith.git @@ -63,12 +56,6 @@ source-repository-package subdir: dependent-sum-template -- https://github.com/obsidiansystems/dependent-sum/pull/59 --- Head of hie-bios -source-repository-package - type: git - location: https://github.com/mpickering/hie-bios - tag: 1875bff093983a0506f80e214eda27e7419da3bc - -- Head of hiedb source-repository-package type: git @@ -84,7 +71,7 @@ source-repository-package write-ghc-environment-files: never -index-state: 2021-08-17T02:21:16Z +index-state: 2021-08-31T02:21:16Z constraints: -- These plugins doesn't work on GHC9 yet diff --git a/ghcide/src/Control/Concurrent/Strict.hs b/ghcide/src/Control/Concurrent/Strict.hs index 2a33e5284b..0fec619680 100644 --- a/ghcide/src/Control/Concurrent/Strict.hs +++ b/ghcide/src/Control/Concurrent/Strict.hs @@ -4,7 +4,8 @@ module Control.Concurrent.Strict ,module Control.Concurrent.Extra ) where -import Control.Concurrent.Extra hiding (modifyVar, modifyVar_) +import Control.Concurrent.Extra hiding (modifyVar, modifyVar', + modifyVar_) import qualified Control.Concurrent.Extra as Extra import Control.Exception (evaluate) import Control.Monad (void) From e49a144c76cdc8ae90e49033d2ce11c2db4a85bb Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 31 Aug 2021 13:22:58 +0200 Subject: [PATCH 05/22] More Compat for GHC 9.2 --- cabal-ghc921.project | 267 ++++++++++++++---- ghcide/ghcide.cabal | 1 - ghcide/src/Control/Concurrent/Strict.hs | 3 +- ghcide/src/Development/IDE/GHC/Compat.hs | 17 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 65 +++-- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 29 +- .../src/Development/IDE/GHC/Compat/Iface.hs | 3 +- .../src/Development/IDE/GHC/Compat/Logger.hs | 19 +- .../Development/IDE/GHC/Compat/Outputable.hs | 83 +++--- .../src/Development/IDE/GHC/Compat/Parser.hs | 1 + .../src/Development/IDE/GHC/Compat/Plugins.hs | 28 +- .../src/Development/IDE/GHC/Compat/Units.hs | 30 +- .../IDE/Plugin/Completions/Logic.hs | 4 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 111 ++++---- hls-test-utils/hls-test-utils.cabal | 2 +- plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 6 +- 16 files changed, 438 insertions(+), 231 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 2798109295..10f24917de 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -15,7 +15,7 @@ packages: ./plugins/hls-explicit-imports-plugin ./plugins/hls-refine-imports-plugin ./plugins/hls-hlint-plugin - ./plugins/hls-retrie-plugin + -- ./plugins/hls-retrie-plugin ./plugins/hls-haddock-comments-plugin -- ./plugins/hls-splice-plugin ./plugins/hls-floskell-plugin @@ -42,20 +42,6 @@ source-repository-package location: https://github.com/HeinrichApfelmus/operational tag: 16e19aaf34e286f3d27b3988c61040823ec66537 -source-repository-package - type: git - location: https://github.com/anka-213/th-extras - tag: 57a97b4df128eb7b360e8ab9c5759392de8d1659 --- https://github.com/mokus0/th-extras/pull/8 --- https://github.com/mokus0/th-extras/issues/7 - -source-repository-package - type: git - location: https://github.com/fendor/dependent-sum - tag: 5de03c38b0de4945f4e9bce1b026110e69dc8118 - subdir: dependent-sum-template --- https://github.com/obsidiansystems/dependent-sum/pull/59 - -- Head of hiedb source-repository-package type: git @@ -75,52 +61,215 @@ index-state: 2021-08-31T02:21:16Z constraints: -- These plugins doesn't work on GHC9 yet - haskell-language-server -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy + haskell-language-server -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy -retrie allow-newer: - -- -- Broken on ghc9, but let's pretend it's not so we can build the other things - -- brittany:base, - -- brittany:ghc, - -- brittany:ghc-boot-th, - -- butcher:base, - -- fourmolu:ghc-lib-parser, - -- stylish-haskell:ghc-lib-parser, - -- stylish-haskell:Cabal, - -- multistate:base, - -- ghc-source-gen:ghc, + Cabal, + base, + binary, + bytestring, + ghc, + ghc-bignum, + ghc-prim, + integer-gmp, + template-haskell, + text, + time, - assoc:base, - cryptohash-md5:base, - cryptohash-sha1:base, - constraints-extras:template-haskell, - data-tree-print:base, - deepseq:base, - dependent-sum:some, - dependent-sum:constraints, - diagrams-postscript:base, - diagrams-postscript:lens, - diagrams-postscript:diagrams-core, - diagrams-postscript:monoid-extras, - diagrams:diagrams-core, - Chart-diagrams:diagrams-core, - SVGFonts:diagrams-core, - dual-tree:base, - -- Does this make any sense? - entropy:Cabal, - force-layout:base, - force-layout:lens, - floskell:ghc-prim, - floskell:base, - hashable:base, - hslogger:base, - monoid-extras:base, - newtype-generics:base, - parallel:base, - regex-base:base, - regex-tdfa:base, - statestack:base, - svg-builder:base, - these:base, - time-compat:base + diagrams-postscript:lens, + diagrams-postscript:diagrams-core, + diagrams-postscript:monoid-extras, + dependent-sum:some, + dependent-sum:constraints, + diagrams:diagrams-core, + Chart-diagrams:diagrams-core, + SVGFonts:diagrams-core +constraints: + Agda ==2.6.1.3, + Diff ==0.4.0, + EdisonAPI ==1.3.1, + EdisonCore ==1.3.2.1, + FPretty ==1.1, + HTTP ==4000.3.16, + HUnit ==1.6.2.0, + QuickCheck ==2.14.2, + Spock-core ==0.14.0.0, + aeson ==1.5.6.0, + aivika ==5.9.1, + aivika-transformers ==5.9.1, + alex ==3.2.6, + ansi-pretty ==0.1.2.2, + arith-encode ==1.0.2, + async ==2.2.3, + async-pool ==0.9.1, + attoparsec ==0.13.2.5 || ==0.14.1, + barbies-th ==0.1.8, + base-compat ==0.11.2, + base-compat-batteries ==0.11.2, + base16-bytestring ==1.0.1.0, + basement ==0.0.12, + bits ==0.5.3, + blaze-builder ==0.4.2.1, + blaze-textual ==0.2.1.0, + boomerang ==1.4.7, + bound ==2.0.3, + box-tuples ==0.2.0.4, + byteslice ==0.2.5.2, + bytesmith ==0.3.7.0, + bytestring-strict-builder ==0.4.5.4, + cabal-doctest ==1.0.8, + cantor-pairing ==0.2.0.1, + cassava ==0.5.2.0, + cborg ==0.2.5.0, + cereal ==0.5.8.1, + charset ==0.3.8, + chaselev-deque ==0.5.0.5, + classy-prelude ==1.5.0, + combinat ==0.2.10.0, + commonmark-extensions ==0.2.1.2, + conduit ==1.3.4.1, + constraints ==0.13, + constraints-extras ==0.3.1.0, + cql ==4.0.3, + critbit ==0.2.0.0, + cryptonite ==0.29, + data-default-instances-new-base ==0.0.2, + data-dword ==0.3.2, + data-r-tree ==0.6.0, + datetime ==0.3.1, + deferred-folds ==0.9.17, + dependent-sum-template ==0.1.0.3, + deriving-compat ==0.5.10, + diagrams-lib ==1.4.4, + doctest ==0.18.1, + dom-lt ==0.2.2.1, + drinkery ==0.4, + edit-distance ==0.2.2.1, + emacs-module ==0.1.1, + endo ==0.3.0.1, + entropy ==0.4.1.6, + enumeration ==0.2.0, + extra ==1.7.9, + fgl ==5.7.0.3, + filepattern ==0.1.2, + focus ==1.0.2, + free-algebras ==0.1.0.1, + free-functors ==1.2.1, + generic-data ==0.9.2.0, + generic-deriving ==1.14, + generic-lens ==2.2.0.0, + generic-lens-core ==2.2.0.0, + generic-optics ==2.2.0.0, + generics-sop ==0.5.1.1, + geniplate-mirror ==0.7.8, + ghc-events ==0.17.0, + happy ==1.20.0, + hashtables ==1.2.4.1, + haskeline ==0.7.5.0, + haskell-src-exts ==1.23.1, + haskell-src-meta ==0.8.7, + haxl ==2.3.0.0, + heterocephalus ==1.0.5.4, + hgeometry ==0.12.0.4, + hgeometry-ipe ==0.12.0.0, + hscolour ==1.24.4, + hslogger ==1.3.1.0, + hspec-core ==2.8.3, + hspec-discover ==2.8.3, + hspec-expectations ==0.8.2, + hspec-meta ==2.7.8, + hspec-wai ==0.11.1, + http-types ==0.12.3, + http2 ==3.0.2, + hvect ==0.4.0.0, + hxt ==9.3.1.22, + inj-base ==0.2.0.0, + inspection-testing ==0.4.6.0, + invariant ==0.5.4, + io-choice ==0.0.7, + iproute ==1.7.11, + language-c ==0.9.0.1, + language-haskell-extract ==0.2.4, + language-javascript ==0.7.1.0, + lens ==5.0.1, + lens-family-th ==0.5.2.0, + list-t ==1.0.4, + lockfree-queue ==0.2.3.1, + memory ==0.16.0, + microlens-ghc ==0.4.13, + monad-validate ==1.2.0.0, + monadplus ==1.4.2, + mono-traversable ==1.0.15.1, + mono-traversable-keys ==0.1.0, + mustache ==2.3.1, + network ==3.1.2.2, + newtype-generics ==0.6, + obdd ==0.8.2, + optics-th ==0.4, + packman ==0.5.0, + pandoc ==2.14.2, + parameterized-utils ==2.1.3.0, + partial-isomorphisms ==0.2.2.1, + pem ==0.2.4, + persistent ==2.13.0.3 || ==2.13.1.1, + plots ==0.1.1.2, + pointed ==5.0.2, + posix-api ==0.3.5.0, + primitive-extras ==0.10.1.1, + primitive-sort ==0.1.0.0, + primitive-unlifted ==0.1.3.0, + proto3-wire ==1.2.2, + quickcheck-instances ==0.3.25.2, + random ==1.2.0, + relude ==1.0.0.1, + row-types ==1.0.1.0, + safe ==0.3.19, + safecopy ==0.10.4.2, + salak ==0.3.6, + securemem ==0.1.10, + semialign ==1.2, + semigroupoids ==5.3.5, + serialise ==0.2.3.0, + servant ==0.18.3, + shake ==0.19.5, + shakespeare ==2.0.25, + singletons ==3.0, + singletons-base ==3.0, + siphash ==1.0.3, + snap-core ==1.0.4.2, + streaming-commons ==0.2.2.1, + streamly ==0.8.0, + subcategories ==0.1.1.0, + test-framework ==0.8.2.0, + text-format ==0.3.2, + text-short ==0.1.3, + text-show ==3.9, + th-desugar ==1.12, + th-extras ==0.0.0.4, + threads ==0.5.1.6, + tls ==1.5.5, + tpdb ==2.2.0, + tree-diff ==0.2, + true-name ==0.1.0.3, + uniplate ==1.6.13, + unordered-containers ==0.2.14.0, + validity ==0.11.0.1, + vector-builder ==0.3.8.2, + vector-circular ==0.1.3, + vector-th-unbox ==0.2.1.9, + vinyl ==0.13.3, + vty ==5.33, + wai-app-static ==3.1.7.2, + wai-extra ==3.1.6, + wai-middleware-static ==0.9.0, + warp ==3.3.17, + winery ==1.3.2, + witherable ==0.4.1, + x509 ==1.7.5, + x509-validation ==1.6.11, + xlsx ==0.8.4, + xml-hamlet ==0.5.0.1, + yaml ==0.11.5.0, + yesod-core ==1.6.21.0 diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 19cebfb594..17d6bc50f8 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -48,7 +48,6 @@ library dependent-map, dependent-sum, dlist, - -- we can't use >= 1.7.10 while we have to use hlint == 3.2.* extra >= 1.7.4 && < 1.7.10, fuzzy, filepath, diff --git a/ghcide/src/Control/Concurrent/Strict.hs b/ghcide/src/Control/Concurrent/Strict.hs index 0fec619680..2a33e5284b 100644 --- a/ghcide/src/Control/Concurrent/Strict.hs +++ b/ghcide/src/Control/Concurrent/Strict.hs @@ -4,8 +4,7 @@ module Control.Concurrent.Strict ,module Control.Concurrent.Extra ) where -import Control.Concurrent.Extra hiding (modifyVar, modifyVar', - modifyVar_) +import Control.Concurrent.Extra hiding (modifyVar, modifyVar_) import qualified Control.Concurrent.Extra as Extra import Control.Exception (evaluate) import Control.Monad (void) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 861a7e0905..293b9df225 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -95,27 +95,24 @@ import Development.IDE.GHC.Compat.Util #if MIN_VERSION_ghc(9,0,0) import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) -#if !MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Env as Env +import GHC.Unit.Module.ModIface +#else import GHC.Driver.Types #endif import GHC.Hs.Extension +import GHC.Iface.Env import GHC.Iface.Make (mkIfaceExports) import qualified GHC.SysTools.Tasks as SysTools import GHC.Tc.Utils.TcType (pprSigmaType) import qualified GHC.Types.Avail as Avail import qualified GHC.Unit.Module.Location as Module +import GHC.Unit.Types #else import DynFlags hiding (ExposePackage) import qualified Module -#if MIN_VERSION_ghc(9,0,0) -import Control.Exception.Safe as Safe (Exception, MonadCatch, catch) -import GHC.Core.TyCo.Ppr (pprSigmaType) -import GHC.Iface.Load -import GHC.Types.Unique.Set (emptyUniqSet) -#else import TcType (pprSigmaType) -#endif - import HscTypes import MkIface hiding (writeIfaceFile) #if MIN_VERSION_ghc(8,10,0) @@ -149,7 +146,7 @@ import Data.IORef import qualified Data.Map as Map -#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,0,0) import qualified Data.Set as S #endif #if MIN_VERSION_ghc(8,8,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 19536b19cd..a1c4cdbf8e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -36,8 +36,9 @@ module Development.IDE.GHC.Compat.Core ( maxValidHoleFits, #if MIN_VERSION_ghc(8,8,0) CommandLineOption, - StaticPlugin(..), +#if !MIN_VERSION_ghc(9,2,0) staticPlugins, +#endif #endif sPgm_F, settings, @@ -181,7 +182,7 @@ module Development.IDE.GHC.Compat.Core ( splitFunTys, splitFunTy_maybe, splitPiTys, - splitForAllTys, + Development.IDE.GHC.Compat.Core.splitForAllTyCoVars, splitTyConApp_maybe, TCvSubst, extendTCvSubst, @@ -496,8 +497,8 @@ module Development.IDE.GHC.Compat.Core ( tcSplitTyConApp_maybe, tcSplitFunTys, tcSplitNestedSigmaTys, - tcSplitForAllTys, - tcSplitForAllTy_maybe, + Development.IDE.GHC.Compat.Core.tcSplitForAllTyVars, + Development.IDE.GHC.Compat.Core.tcSplitForAllTyVarBinder_maybe, tcSplitSigmaTy, TcTyThing(..), tcTyConAppTyCon_maybe, @@ -657,12 +658,12 @@ import GHC.Core.DataCon as DataCon import GHC.Core.FamInstEnv import GHC.Core.InstEnv #if MIN_VERSION_ghc(9,2,0) -import GHC.Core.Multiplicity (Scaled, scaledThing) +import GHC.Core.Multiplicity (scaledThing) #else -import GHC.Core.PatSyn +import GHC.Core.Ppr.TyThing import GHC.Core.TyCo.Rep (scaledThing) #endif -import GHC.Core.Ppr.TyThing +import GHC.Core.PatSyn import GHC.Core.Predicate import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Core.TyCon @@ -671,7 +672,6 @@ import GHC.Core.Utils #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env -import GHC.Driver.Env.Types #else import GHC.Driver.Finder import GHC.Driver.Types @@ -686,11 +686,9 @@ import GHC.Driver.Pipeline import GHC.Driver.Plugins import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Driver.Session as DynFlags -#if !MIN_VERSION_ghc(9,2,0) import GHC.HsToCore.Docs import GHC.HsToCore.Expr import GHC.HsToCore.Monad -#endif import GHC.Iface.Load import GHC.Iface.Make (mkFullIface, mkIfaceTc, mkPartialIface) @@ -700,38 +698,41 @@ import GHC.Iface.Tidy import GHC.IfaceToCore import GHC.Parser import GHC.Parser.Header +import GHC.Parser.Lexer #if MIN_VERSION_ghc(9,2,0) import GHC.Linker.Loader import GHC.Linker.Types import GHC.Platform.Ways #else -import GHC.Parser.Lexer -import GHC.Runtime.Interpreter import GHC.Runtime.Linker #endif import GHC.Rename.Names import GHC.Rename.Splice +import GHC.Runtime.Interpreter import GHC.Tc.Instance.Family import GHC.Tc.Module import GHC.Tc.Types import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad -import GHC.Tc.Utils.TcType +import GHC.Tc.Utils.TcType as TcType import qualified GHC.Types.Avail as Avail #if MIN_VERSION_ghc(9,2,0) import GHC.Types.Meta -#else +#endif import GHC.Types.Basic import GHC.Types.Id -#endif import GHC.Types.Name hiding (varName) import GHC.Types.Name.Cache import GHC.Types.Name.Env import GHC.Types.Name.Reader #if MIN_VERSION_ghc(9,2,0) +import GHC.Types.Name.Set import GHC.Types.SourceFile (HscSource (..), SourceModified (..)) +import GHC.Types.SourceText +import GHC.Types.TyThing +import GHC.Types.TyThing.Ppr #else import GHC.Types.Name.Set #endif @@ -740,16 +741,16 @@ import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique.Supply import GHC.Types.Var #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Env import GHC.Unit.Finder import GHC.Unit.Home.ModInfo #endif import GHC.Unit.Info (PackageName (..)) import GHC.Unit.Module #if MIN_VERSION_ghc(9,2,0) +import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (IfaceExport, mi_mod_hash) +import GHC.Unit.Module.ModIface (IfaceExport) #endif import GHC.Unit.State (ModuleOrigin (..)) import GHC.Utils.Panic hiding (try) @@ -960,7 +961,33 @@ mkVisFunTys = mkInfForAllTys :: [TyVar] -> Type -> Type mkInfForAllTys = #if MIN_VERSION_ghc(9,0,0) - TcType.mkInfForAllTys + TcType.mkInfForAllTys +#else + mkInvForAllTys +#endif + +splitForAllTyCoVars :: Type -> ([TyCoVar], Type) +splitForAllTyCoVars = +#if MIN_VERSION_ghc(9,2,0) + TcType.splitForAllTyCoVars #else - mkInvForAllTys + splitForAllTys #endif + +tcSplitForAllTyVars :: Type -> ([TyVar], Type) +tcSplitForAllTyVars = +#if MIN_VERSION_ghc(9,2,0) + TcType.tcSplitForAllTyVars +#else + tcSplitForAllTys +#endif + + +tcSplitForAllTyVarBinder_maybe :: Type -> Maybe (TyVarBinder, Type) +tcSplitForAllTyVarBinder_maybe = +#if MIN_VERSION_ghc(9,2,0) + TcType.tcSplitForAllTyVarBinder_maybe +#else + tcSplitForAllTy_maybe +#endif + diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 39c0d2a616..2def0e4121 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -19,7 +19,7 @@ module Development.IDE.GHC.Compat.Env ( hscHomeUnit, HomeUnit, setHomeUnitId_, - mkHomeModule, + Development.IDE.GHC.Compat.Env.mkHomeModule, -- * Provide backwards Compatible -- types and helper functions. Logger(..), @@ -28,7 +28,7 @@ module Development.IDE.GHC.Compat.Env ( hscSetFlags, initTempFs, -- * Home Unit - homeUnitId_, + Development.IDE.GHC.Compat.Env.homeUnitId_, -- * DynFlags Helper setBytecodeLinkerOptions, setInterpreterLinkerOptions, @@ -42,19 +42,23 @@ module Development.IDE.GHC.Compat.Env ( -- * Backend, backwards compatible Backend, setBackend, - platformDefaultBackend, + Development.IDE.GHC.Compat.Env.platformDefaultBackend, ) where import GHC (setInteractiveDynFlags) #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env (HscEnv) +import GHC.Driver.Backend as Backend +import GHC.Driver.Env (HscEnv, hsc_EPS) import qualified GHC.Driver.Env as Env -import qualified GHC.Driver.Session as Home +import qualified GHC.Driver.Session as Session import GHC.Platform.Ways hiding (hostFullWays) import qualified GHC.Platform.Ways as Ways +import GHC.Runtime.Context import GHC.Unit.Env (UnitEnv) +import GHC.Unit.Home as Home +import GHC.Utils.Logger import GHC.Utils.TmpFs #else import qualified GHC.Driver.Session as DynFlags @@ -78,8 +82,9 @@ import Module #if MIN_VERSION_ghc(9,0,0) import qualified Data.Set as Set #endif +#if !MIN_VERSION_ghc(9,2,0) import Data.IORef - +#endif #if !MIN_VERSION_ghc(9,2,0) type UnitEnv = () @@ -89,7 +94,7 @@ type TmpFs = () setHomeUnitId_ :: UnitId -> DynFlags -> DynFlags #if MIN_VERSION_ghc(9,2,0) -setHomeUnitId_ uid df = df { homeUnitId_ = uid } +setHomeUnitId_ uid df = df { Session.homeUnitId_ = uid } #elif MIN_VERSION_ghc(9,0,0) setHomeUnitId_ uid df = df { homeUnitId = uid } #else @@ -118,7 +123,7 @@ initTempFs env = do hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv #if MIN_VERSION_ghc(9,2,0) -hscSetUnitEnv ue env = env { hsc_unit_env = ue } +hscSetUnitEnv ue env = env { Env.hsc_unit_env = ue } #else hscSetUnitEnv _ env = env #endif @@ -166,7 +171,7 @@ hscSetHooks hooks env = homeUnitId_ :: DynFlags -> UnitId homeUnitId_ = #if MIN_VERSION_ghc(9,2,0) - homeUnitId_ + Session.homeUnitId_ #elif MIN_VERSION_ghc(9,0,0) homeUnitId #else @@ -183,7 +188,7 @@ type HomeUnit = UnitId hscHomeUnit :: HscEnv -> HomeUnit hscHomeUnit = #if MIN_VERSION_ghc(9,2,0) - ue_home_unit . Env.hsc_unit_env + Env.hsc_home_unit #elif MIN_VERSION_ghc(9,0,0) homeUnit . Env.hsc_dflags #else @@ -244,7 +249,7 @@ hostFullWays = setWays :: Ways -> DynFlags -> DynFlags setWays ways flags = #if MIN_VERSION_ghc(9,2,0) - flags { targetWays = ways} + flags { Session.targetWays_ = ways} #elif MIN_VERSION_ghc(9,0,0) flags {ways = ways} #else @@ -262,7 +267,7 @@ type Backend = HscTarget platformDefaultBackend :: DynFlags -> Backend platformDefaultBackend = #if MIN_VERSION_ghc(9,2,0) - platformDefaultBackend . targetPlatform + Backend.platformDefaultBackend . targetPlatform #elif MIN_VERSION_ghc(8,10,0) defaultObjectTarget #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index b59e95908b..36ac26a446 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -9,7 +9,6 @@ module Development.IDE.GHC.Compat.Iface ( import GHC #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Iface.Load as Iface -import qualified GHC.Unit.Finder as Finder import GHC.Unit.Finder.Types (FindResult) #elif MIN_VERSION_ghc(9,0,0) import qualified GHC.Driver.Finder as Finder @@ -26,7 +25,7 @@ import Development.IDE.GHC.Compat.Outputable writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () #if MIN_VERSION_ghc(9,2,0) -writeIfaceFile env fp iface = Iface.writeIface (hsc_logger) (hsc_dflags env) fp iface +writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (hsc_dflags env) fp iface #elif MIN_VERSION_ghc(9,0,0) writeIfaceFile env = Iface.writeIface (hsc_dflags env) #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 53eb38c9cc..cb94532eb7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -2,7 +2,7 @@ -- | Compat module for GHC 9.2 Logger infrastructure. module Development.IDE.GHC.Compat.Logger ( putLogHook, - pushLogHook, + Development.IDE.GHC.Compat.Logger.pushLogHook, -- * Logging stuff LogActionCompat, logActionCompat, @@ -17,9 +17,8 @@ import Development.IDE.GHC.Compat.Outputable import GHC.Driver.Session as DynFlags import GHC.Utils.Outputable #if MIN_VERSION_ghc(9,2,0) -import GHC.Utils.Logger -#else -import GHC.Driver.Session +import GHC.Driver.Env (hsc_logger) +import GHC.Utils.Logger as Logger #endif #else import DynFlags @@ -28,11 +27,19 @@ import Outputable (queryQual) putLogHook :: Logger -> HscEnv -> HscEnv putLogHook logger env = - hscSetFlags ((hsc_dflags env) { DynFlags.log_action = Env.log_action logger }) env +#if MIN_VERSION_ghc(9,2,0) + env { hsc_logger = logger } +#else + hscSetFlags ((hsc_dflags env) { DynFlags.log_action = Env.log_action logger }) env +#endif pushLogHook :: (LogAction -> LogAction) -> Logger -> Logger pushLogHook f logger = - logger { Env.log_action = f (Env.log_action logger) } +#if MIN_VERSION_ghc(9,2,0) + Logger.pushLogHook f logger +#else + logger { Env.log_action = f (Env.log_action logger) } +#endif #if MIN_VERSION_ghc(9,0,0) type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO () diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index be730e5bf6..1b2d1fb14c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -31,57 +31,60 @@ module Development.IDE.GHC.Compat.Outputable ( #if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Session -import GHC.Driver.Ppr -import qualified GHC.Types.Error as Error -import GHC.Types.SrcLoc -import GHC.Types.SourceError -import GHC.Unit.State (emptyUnitState) -import GHC.Utils.Error hiding (mkWarnMsg) -import GHC.Utils.Outputable -import GHC.Utils.Logger -import GHC.Utils.Panic -import GHC.Parser.Errors -import qualified GHC.Parser.Errors.Ppr as Ppr +import GHC.Driver.Ppr +import GHC.Driver.Session +import GHC.Parser.Errors +import qualified GHC.Parser.Errors.Ppr as Ppr +import qualified GHC.Types.Error as Error +import GHC.Types.Name.Ppr +import GHC.Types.SourceError +import GHC.Types.SrcLoc +import GHC.Unit.State +import GHC.Utils.Error hiding (mkWarnMsg) +import GHC.Utils.Logger +import GHC.Utils.Outputable +import GHC.Utils.Panic #elif MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Types -import GHC.Driver.Session -import GHC.Utils.Outputable as Out -import GHC.Types.SrcLoc -import GHC.Utils.Error as Err hiding (mkWarnMsg) -import qualified GHC.Utils.Error as Err -import GHC.Types.Name.Reader (GlobalRdrEnv) +import GHC.Driver.Session +import GHC.Driver.Types as HscTypes +import GHC.Types.Name.Reader (GlobalRdrEnv) +import GHC.Types.SrcLoc +import GHC.Utils.Error as Err hiding (mkWarnMsg) +import qualified GHC.Utils.Error as Err +import GHC.Utils.Outputable as Out #else -import DynFlags -import Outputable as Out -import HscTypes -import qualified ErrUtils as Err -import SrcLoc -import ErrUtils hiding (mkWarnMsg) -import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) +import DynFlags +import ErrUtils hiding (mkWarnMsg) +import qualified ErrUtils as Err +import HscTypes +import Outputable as Out +import SrcLoc #endif +import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) + printNameWithoutUniques :: Outputable a => a -> String printNameWithoutUniques = #if MIN_VERSION_ghc(9,2,0) - renderWithContext (defaultSDocContext { sdocSuppressUniques = True }) . ppr + renderWithContext (defaultSDocContext { sdocSuppressUniques = True }) . ppr #else - printSDocAllTheWay dyn . ppr + printSDocAllTheWay dyn . ppr where dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques #endif printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String -printSDocQualifiedUnsafe unqual doc = #if MIN_VERSION_ghc(9,2,0) +printSDocQualifiedUnsafe unqual doc = -- Taken from 'showSDocForUser' - renderWithContext (initSDocContext dflags sty) doc' + renderWithContext (defaultSDocContext { sdocStyle = sty }) doc' where sty = mkUserStyle unqual AllTheWay doc' = pprWithUnitState emptyUnitState doc #else - showSDocForUser unsafeGlobalDynFlags unqual doc +printSDocQualifiedUnsafe unqual doc = + showSDocForUser unsafeGlobalDynFlags unqual doc #endif printSDocAllTheWay :: DynFlags -> SDoc -> String @@ -135,12 +138,12 @@ pprError = formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String formatErrorWithQual dflags e = #if MIN_VERSION_ghc(9,2,0) - showSDoc dflags (pprLocMsgEnvelope e) + showSDoc dflags (pprLocMsgEnvelope e) #else - Out.showSDoc dflags - $ Out.withPprStyle (oldMkErrStyle dflags $ errMsgContext e) - $ oldFormatErrDoc dflags - $ Err.errMsgDoc e + Out.showSDoc dflags + $ Out.withPprStyle (oldMkErrStyle dflags $ errMsgContext e) + $ oldFormatErrDoc dflags + $ Err.errMsgDoc e #endif #if !MIN_VERSION_ghc(9,2,0) @@ -151,18 +154,14 @@ type PsWarning = ErrMsg type PsError = ErrMsg #endif --- | Like 'mkPrintUnqualified', but requires no additional context, --- such as DynFlags or, in later GHC versions, UnitState by relying --- on defaults. mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault = #if MIN_VERSION_ghc(9,2,0) - mkPrintUnqualified emptyUnitState + GHC.Types.Name.Ppr.mkPrintUnqualified undefined #else - mkPrintUnqualified unsafeGlobalDynFlags + HscTypes.mkPrintUnqualified unsafeGlobalDynFlags #endif - mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc mkWarnMsg = #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index d746202f8a..21440a5346 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -23,6 +23,7 @@ module Development.IDE.GHC.Compat.Parser ( import qualified GHC.Parser.Lexer as Lexer #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Config as Config +import GHC.Parser.Lexer hiding (initParserState) #else import qualified GHC.Parser.Annotation as Anno #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 4d63b9113e..f7b0793337 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -9,19 +9,29 @@ module Development.IDE.GHC.Compat.Plugins ( #endif applyPluginsParsedResultAction, initializePlugins, + + -- * Static plugins +#if MIN_VERSION_ghc(8,8,0) + StaticPlugin(..), + hsc_static_plugins, +#endif ) where import GHC #if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Driver.Env as Env +#else +import GHC.Driver.Session (staticPlugins) +#endif import GHC.Driver.Plugins (Plugin (..), PluginWithArgs (..), + StaticPlugin (..), defaultPlugin, withPlugins) import qualified GHC.Runtime.Loader as Loader -#elif __GLASGOW_HASKELL__ >= 808 +#elif MIN_VERSION_ghc(8,8,0) import qualified DynamicLoading as Loader -import Plugins (Plugin (..), - PluginWithArgs (..), - defaultPlugin, withPlugins) +import Plugins #else import qualified DynamicLoading as Loader import Plugins (Plugin (..), defaultPlugin, @@ -53,3 +63,13 @@ initializePlugins env = do newDf <- Loader.initializePlugins env (hsc_dflags env) pure $ hscSetFlags newDf env #endif + + +#if MIN_VERSION_ghc(8,8,0) +hsc_static_plugins :: HscEnv -> [StaticPlugin] +#if MIN_VERSION_ghc(9,2,0) +hsc_static_plugins = Env.hsc_static_plugins +#else +hsc_static_plugins = staticPlugins . hsc_dflags +#endif +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 8b3c38f954..9f69100559 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -49,14 +49,17 @@ module Development.IDE.GHC.Compat.Units ( #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Data.ShortText as ST +import GHC.Driver.Env (hsc_unit_dbs) import GHC.Unit.Env +import GHC.Unit.External #else -import GHC.Driver.Session (PackageArg (..), - PackageFlag (..)) -import qualified GHC.Driver.Session as DynFlags import GHC.Driver.Types #endif import GHC.Data.FastString +import GHC.Driver.Session (PackageArg (..), + PackageFlag (..)) +import qualified GHC.Driver.Session as DynFlags import GHC.Types.Unique.Set import qualified GHC.Unit.Info as UnitInfo import GHC.Unit.Module.Name (ModuleName) @@ -128,22 +131,21 @@ initUnits env = do #if MIN_VERSION_ghc(9,2,0) let dflags1 = hsc_dflags env -- Copied from GHC.setSessionDynFlags - let old_unit_env = hsc_unit_env env - let cached_unit_dbs = ue_unit_dbs old_unit_env - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits (hsc_logger env) dflags1 cached_unit_dbs + let cached_unit_dbs = hsc_unit_dbs env + (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags1 cached_unit_dbs + + dflags <- updatePlatformConstants dflags1 mconstants - dflags <- liftIO $ updatePlatformConstants dflags1 mconstants let unit_env = UnitEnv { ue_platform = targetPlatform dflags , ue_namever = ghcNameVersion dflags - , ue_home_unit = Just home_unit - , ue_hpt = ue_hpt old_unit_env - , ue_eps = ue_eps old_unit_env + , ue_home_unit = home_unit , ue_units = unit_state - , ue_unit_dbs = Just dbs } - pure $ hscSetFlags dflags env { hsc_unit_env = unit_env } + pure $ hscSetFlags dflags $ hscSetUnitEnv unit_env env + { hsc_unit_dbs = Just dbs + } #elif MIN_VERSION_ghc(9,0,0) newFlags <- State.initUnits $ hsc_dflags env pure $ hscSetFlags newFlags env @@ -258,7 +260,9 @@ unitInfoId = unitHaddockInterfaces :: UnitInfo -> [FilePath] unitHaddockInterfaces = -#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,2,0) + fmap ST.unpack . UnitInfo.unitHaddockInterfaces +#elif MIN_VERSION_ghc(9,0,0) UnitInfo.unitHaddockInterfaces #else haddockInterfaces diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 9aab9bce9e..68d27bf244 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -36,8 +36,8 @@ import qualified Data.HashSet as HashSet import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat as GHC -import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Compat.Outputable hiding (ppr) +import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types @@ -254,7 +254,7 @@ mkNameCompItem doc thingParent origName origMod thingType isInfix docs !imp = CI getArgs t | isPredTy t = [] | isDictTy t = [] - | isForAllTy t = getArgs $ snd (splitForAllTys t) + | isForAllTy t = getArgs $ snd (splitForAllTyCoVars t) | isFunTy t = let (args, ret) = splitFunTys t in if isForAllTy ret diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 36930d4388..ce9c0d8317 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -12,61 +12,63 @@ module Development.IDE.Plugin.TypeLenses ( GlobalBindingTypeSigsResult (..), ) where -import Control.DeepSeq (rwhnf) -import Control.Monad (mzero) -import Control.Monad.Extra (whenMaybe) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.Aeson.Types (Value (..), toJSON) -import qualified Data.Aeson.Types as A -import qualified Data.HashMap.Strict as Map -import Data.List (find) -import Data.Maybe (catMaybes) -import qualified Data.Text as T -import Development.IDE (GhcSession (..), - HscEnvEq (hscEnv), - RuleResult, Rules, define, - srcSpanToRange) -import Development.IDE.Core.Compile (TcModuleResult (..)) -import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), - TypeCheck (TypeCheck)) -import Development.IDE.Core.Rules (IdeState, runAction) -import Development.IDE.Core.Service (getDiagnostics) -import Development.IDE.Core.Shake (getHiddenDiagnostics, use) +import Control.DeepSeq (rwhnf) +import Control.Monad (mzero) +import Control.Monad.Extra (whenMaybe) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Aeson.Types (Value (..), toJSON) +import qualified Data.Aeson.Types as A +import qualified Data.HashMap.Strict as Map +import Data.List (find) +import Data.Maybe (catMaybes) +import qualified Data.Text as T +import Development.IDE (GhcSession (..), + HscEnvEq (hscEnv), + RuleResult, Rules, + define, srcSpanToRange) +import Development.IDE.Core.Compile (TcModuleResult (..)) +import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), + TypeCheck (TypeCheck)) +import Development.IDE.Core.Rules (IdeState, runAction) +import Development.IDE.Core.Service (getDiagnostics) +import Development.IDE.Core.Shake (getHiddenDiagnostics, + use) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Outputable -import Development.IDE.GHC.Util (printName) +import Development.IDE.GHC.Util (printName) import Development.IDE.Graph.Classes -import Development.IDE.Spans.LocalBindings (Bindings, getFuzzyScope) -import Development.IDE.Types.Location (Position (Position, _character, _line), - Range (Range, _end, _start), - toNormalizedFilePath', - uriToFilePath') -import GHC.Generics (Generic) -import Ide.Plugin.Config (Config) +import Development.IDE.Spans.LocalBindings (Bindings, getFuzzyScope) +import Development.IDE.Types.Location (Position (Position, _character, _line), + Range (Range, _end, _start), + toNormalizedFilePath', + uriToFilePath') +import GHC.Generics (Generic) +import Ide.Plugin.Config (Config) import Ide.Plugin.Properties -import Ide.PluginUtils (mkLspCommand, - usePropertyLsp) -import Ide.Types (CommandFunction, - CommandId (CommandId), - PluginCommand (PluginCommand), - PluginDescriptor (..), - PluginId, - configCustomConfig, - defaultConfigDescriptor, - defaultPluginDescriptor, - mkCustomConfig, - mkPluginHandler) -import qualified Language.LSP.Server as LSP -import Language.LSP.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), - CodeLens (CodeLens), - CodeLensParams (CodeLensParams, _textDocument), - Diagnostic (..), - List (..), ResponseError, - SMethod (..), - TextDocumentIdentifier (TextDocumentIdentifier), - TextEdit (TextEdit), - WorkspaceEdit (WorkspaceEdit)) -import Text.Regex.TDFA ((=~), (=~~)) +import Ide.PluginUtils (mkLspCommand, + usePropertyLsp) +import Ide.Types (CommandFunction, + CommandId (CommandId), + PluginCommand (PluginCommand), + PluginDescriptor (..), + PluginId, + configCustomConfig, + defaultConfigDescriptor, + defaultPluginDescriptor, + mkCustomConfig, + mkPluginHandler) +import qualified Language.LSP.Server as LSP +import Language.LSP.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), + CodeLens (CodeLens), + CodeLensParams (CodeLensParams, _textDocument), + Diagnostic (..), + List (..), + ResponseError, + SMethod (..), + TextDocumentIdentifier (TextDocumentIdentifier), + TextEdit (TextEdit), + WorkspaceEdit (WorkspaceEdit)) +import Text.Regex.TDFA ((=~), (=~~)) typeLensCommandId :: T.Text typeLensCommandId = "typesignature.add" @@ -212,8 +214,8 @@ instance A.FromJSON Mode where -------------------------------------------------------------------------------- -showDocRdrEnv :: DynFlags -> GlobalRdrEnv -> SDoc -> String -showDocRdrEnv dflags rdrEnv = showSDocForUser dflags (mkPrintUnqualified dflags rdrEnv) +showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String +showDocRdrEnv env rdrEnv = showSDocForUser (hsc_dflags env) (mkPrintUnqualified (hsc_dflags env) rdrEnv) data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs deriving (Generic, Show, Eq, Ord, Hashable, NFData, Binary) @@ -252,9 +254,8 @@ gblBindingType (Just hsc) (Just gblEnv) = do sigs = tcg_sigs gblEnv binds = collectHsBindsBinders $ tcg_binds gblEnv patSyns = tcg_patsyns gblEnv - dflags = hsc_dflags hsc rdrEnv = tcg_rdr_env gblEnv - showDoc = showDocRdrEnv dflags rdrEnv + showDoc = showDocRdrEnv hsc rdrEnv hasSig :: (Monad m) => Name -> m a -> m (Maybe a) hasSig name f = whenMaybe (name `elemNameSet` sigs) f bindToSig id = do diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index dc25afb526..eb139c8908 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -44,7 +44,7 @@ library , ghcide ^>=1.4 , hls-graph , hls-plugin-api ^>=1.2 - , hspec <2.8 + , hspec <2.9 , hspec-core , lens , lsp ^>=1.2 diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index 890962e009..6897c33768 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -75,7 +75,7 @@ tacticsThetaTy (tcSplitSigmaTy -> (_, theta, _)) = theta -- | Get the data cons of a type, if it has any. tacticsGetDataCons :: Type -> Maybe ([DataCon], [Type]) tacticsGetDataCons ty - | Just (_, ty') <- tcSplitForAllTy_maybe ty + | Just (_, ty') <- tcSplitForAllTyVarBinder_maybe ty = tacticsGetDataCons ty' tacticsGetDataCons ty | Just _ <- algebraicTyCon ty @@ -101,7 +101,7 @@ freshTyvars t = do case M.lookup tv reps of Just tv' -> tv' Nothing -> tv - ) $ snd $ tcSplitForAllTys t + ) $ snd $ tcSplitForAllTyVars t ------------------------------------------------------------------------------ @@ -120,7 +120,7 @@ getRecordFields dc = -- | Is this an algebraic type? algebraicTyCon :: Type -> Maybe TyCon algebraicTyCon ty - | Just (_, ty') <- tcSplitForAllTy_maybe ty + | Just (_, ty') <- tcSplitForAllTyVarBinder_maybe ty = algebraicTyCon ty' algebraicTyCon (splitTyConApp_maybe -> Just (tycon, _)) | tycon == intTyCon = Nothing From 3542de4602ed5f1d5219086ef11fdf957e56d77c Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 1 Sep 2021 22:56:19 +0200 Subject: [PATCH 06/22] Uncomment refineImports package --- cabal-ghc901.project | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 1de27de88d..401e8fcc60 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -7,13 +7,13 @@ packages: ./hls-plugin-api ./hls-test-utils -- ./plugins/hls-tactics-plugin - -- ./plugins/hls-brittany-plugin - -- ./plugins/hls-stylish-haskell-plugin - -- ./plugins/hls-fourmolu-plugin + -- ./plugins/hls-brittany-plugin + -- ./plugins/hls-stylish-haskell-plugin + -- ./plugins/hls-fourmolu-plugin -- ./plugins/hls-class-plugin ./plugins/hls-eval-plugin ./plugins/hls-explicit-imports-plugin - -- ./plugins/hls-refine-imports-plugin + ./plugins/hls-refine-imports-plugin ./plugins/hls-hlint-plugin ./plugins/hls-rename-plugin ./plugins/hls-retrie-plugin From d3e9dbcb524309f44e2ca633332cd478d0fa148c Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 1 Sep 2021 23:41:49 +0200 Subject: [PATCH 07/22] Drop ghc-api-compat from stack.yaml --- stack-9.0.1.yaml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index 5e71865dac..da36dc3893 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -13,11 +13,11 @@ packages: - ./plugins/hls-haddock-comments-plugin - ./plugins/hls-eval-plugin - ./plugins/hls-explicit-imports-plugin - # - ./plugins/hls-refine-imports-plugin + - ./plugins/hls-refine-imports-plugin - ./plugins/hls-hlint-plugin - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - # - ./plugins/hls-splice-plugin + - ./plugins/hls-splice-plugin # - ./plugins/hls-tactics-plugin # - ./plugins/hls-brittany-plugin # - ./plugins/hls-stylish-haskell-plugin @@ -104,8 +104,6 @@ flags: pedantic: true class: false - splice: false - refineImports: false tactic: false # Dependencies fail fourmolu: false From 31b65511736328cb3fe204e3e5fed1fca5191f34 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 2 Sep 2021 08:59:09 +0200 Subject: [PATCH 08/22] Remove ghc-api-compat for all stack.yaml's --- stack-8.10.2.yaml | 1 - stack-8.10.3.yaml | 1 - stack-8.10.4.yaml | 1 - stack-8.10.5.yaml | 1 - stack-8.10.6.yaml | 50 +++++++++++++++++++++++++++++++---------------- stack-8.6.4.yaml | 1 - stack-8.6.5.yaml | 1 - stack-8.8.3.yaml | 1 - stack-8.8.4.yaml | 1 - stack.yaml | 1 - 10 files changed, 33 insertions(+), 26 deletions(-) diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index 13663cba29..19c0d27b8d 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -38,7 +38,6 @@ extra-deps: - data-tree-print-0.1.0.2@rev:2 - floskell-0.10.4 - fourmolu-0.3.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index a24c3512d3..257340de8d 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -38,7 +38,6 @@ extra-deps: - data-tree-print-0.1.0.2@rev:2 - floskell-0.10.4 - fourmolu-0.3.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml index f00ff4d014..d68662b281 100644 --- a/stack-8.10.4.yaml +++ b/stack-8.10.4.yaml @@ -38,7 +38,6 @@ extra-deps: - data-tree-print-0.1.0.2@rev:2 - floskell-0.10.4 - fourmolu-0.3.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 - ghc-source-gen-0.4.1.0 diff --git a/stack-8.10.5.yaml b/stack-8.10.5.yaml index b97fc70e81..400886fd40 100644 --- a/stack-8.10.5.yaml +++ b/stack-8.10.5.yaml @@ -41,7 +41,6 @@ extra-deps: - data-tree-print-0.1.0.2@rev:2 - floskell-0.10.5 - fourmolu-0.3.0.0 - - ghc-api-compat-8.10.5 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 - ghc-source-gen-0.4.1.0 diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index 2675a9bbdc..673e78ab41 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -31,23 +31,39 @@ ghc-options: "$everything": -haddock extra-deps: - - brittany-0.13.1.2@sha256:9922614f1df18c63755a37c144033988788e0769fd9c2630b64ed0dfb49462bd,8197 - - bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738 - - data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 - - floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803 - - ghc-api-compat-8.10.6@sha256:cde370b1b4c8a090de1ba6a8e27f65def9af43ca88710b412a6545b876568626,3324 - - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - - hiedb-0.4.0.0@sha256:b6dadd5cefc8c1052bc4b29144f616ca9c22e863a96d8e447d66a4d32c96fd4a,2987 - - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - - lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431 - - lsp-test-0.14.0.1@sha256:efce2ddec4183390341db7667e63936954c654a14d809ad7b61e4010a2fde97e,4739 - - lsp-types-1.3.0.1@sha256:1dc41eb358345c1927fb8f285e7d951869623fe5b695fbbecf2fe6a3cee9fcfd,4646 - - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 - - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 - - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 - - retrie-1.0.0.0@sha256:82014773115807f649f60fe4a3246911bbccd063a3c846cf5665e71f237bdd2d,4241 - - stylish-haskell-0.12.2.0@sha256:38f7fd9ca30c9aad34f176dae4564576899e9c197b6b8557b59c5e8c6a622c74,6108 + - apply-refact-0.9.3.0 + - brittany-0.13.1.2 + - Cabal-3.0.2.0 + - clock-0.7.2 + - data-tree-print-0.1.0.2@rev:2 + - floskell-0.10.5 + - fourmolu-0.3.0.0 + - ghc-check-0.5.0.4 + - ghc-exactprint-0.6.4 + - ghc-source-gen-0.4.1.0 + - heapsize-0.3.0 + - implicit-hie-cradle-0.3.0.5 + - implicit-hie-0.1.2.6 + - monad-dijkstra-0.1.1.2 + # For stylish-haskell-0.12.2.0 + - optparse-applicative-0.15.1.0 + - refinery-0.4.0.0 + - retrie-1.0.0.0 + - stylish-haskell-0.12.2.0 + - semigroups-0.18.5 + - temporary-1.2.1.1 + - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 + - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 + - hiedb-0.4.0.0 + - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 + - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 + - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 + - constraints-extras-0.3.1.0 + - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055 + - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 + - lsp-1.2.0.1 + - lsp-types-1.3.0.1 + - lsp-test-0.14.0.1 # Enable these when supported by all formatters # - ghc-lib-9.0.1.20210324@sha256:c8b9a2541ea3424c8d0e4f80584477d0f35be03f4a47d931152042d5f446c5fc,19279 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 82c9b6628b..6a6c0025a8 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -45,7 +45,6 @@ extra-deps: - floskell-0.10.4 - fourmolu-0.3.0.0 - fuzzy-0.1.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-events-0.13.0 - ghc-exactprint-0.6.4 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 51d4473532..84fb6ab4a9 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -46,7 +46,6 @@ extra-deps: - floskell-0.10.4 - fourmolu-0.3.0.0 - fuzzy-0.1.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-events-0.13.0 - ghc-exactprint-0.6.4 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index e1fc082b96..8dff8f8f74 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -40,7 +40,6 @@ extra-deps: - constrained-dynamic-0.1.0.0 - floskell-0.10.4 - fourmolu-0.3.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 3742c83f56..7dd356c9c0 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -40,7 +40,6 @@ extra-deps: - constrained-dynamic-0.1.0.0 - floskell-0.10.4 - fourmolu-0.3.0.0 - - ghc-api-compat-8.6 - ghc-check-0.5.0.4 - ghc-exactprint-0.6.4 - ghc-lib-8.10.4.20210206 diff --git a/stack.yaml b/stack.yaml index 67e3104e9f..f3726ef63b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -38,7 +38,6 @@ extra-deps: - data-tree-print-0.1.0.2@rev:2 - floskell-0.10.4 - fourmolu-0.3.0.0 - - ghc-api-compat-8.6 - ghc-exactprint-0.6.4 - ghc-source-gen-0.4.1.0 - heapsize-0.3.0 From 152bce8e404b814584444db81b286ea2d19c789b Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 2 Sep 2021 10:21:05 +0200 Subject: [PATCH 09/22] Use hiedb hackage release --- cabal-ghc901.project | 6 ------ ghcide/ghcide.cabal | 2 +- stack-8.10.2.yaml | 2 +- stack-8.10.3.yaml | 2 +- stack-8.10.4.yaml | 2 +- stack-8.10.5.yaml | 2 +- stack-8.10.6.yaml | 2 +- stack-8.6.4.yaml | 2 +- stack-8.6.5.yaml | 2 +- stack-8.8.3.yaml | 2 +- stack-8.8.4.yaml | 2 +- stack-9.0.1.yaml | 2 +- stack.yaml | 2 +- 13 files changed, 12 insertions(+), 18 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 401e8fcc60..1ae685a8e1 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -39,12 +39,6 @@ source-repository-package tag: b6245884ae83e00dd2b5261762549b37390179f8 -- https://github.com/lspitzner/czipwith/pull/2 --- Head of hiedb -source-repository-package - type: git - location: https://github.com/wz1000/HieDb - tag: 45c4671db2da8ce5cd11e964573846cfbf3bbec8 - source-repository-package type: git location: https://github.com/anka-213/th-extras diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 17d6bc50f8..353791c9dd 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -60,7 +60,7 @@ library hie-compat ^>= 0.2.0.0, hls-plugin-api ^>= 1.2.0.0, lens, - hiedb == 0.4.0.*, + hiedb == 0.4.1.*, lsp-types >= 1.3.0.1 && < 1.4, lsp == 1.2.*, mtl, diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index 19c0d27b8d..085909f607 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -56,7 +56,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index 257340de8d..8ce1cce932 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -56,7 +56,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml index d68662b281..82f9d4dc33 100644 --- a/stack-8.10.4.yaml +++ b/stack-8.10.4.yaml @@ -52,7 +52,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.10.5.yaml b/stack-8.10.5.yaml index 400886fd40..f94d4f74ef 100644 --- a/stack-8.10.5.yaml +++ b/stack-8.10.5.yaml @@ -57,7 +57,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index 673e78ab41..42166caea2 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -54,7 +54,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 6a6c0025a8..5329bef27f 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -91,7 +91,7 @@ extra-deps: - th-env-0.1.0.2@sha256:d8f1f37f42a8f1a22404d7d0579528af18f5dac7232cca6bdbd5117c115a0ad5,1370 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 84fb6ab4a9..cb42915a43 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -92,7 +92,7 @@ extra-deps: - th-env-0.1.0.2@sha256:d8f1f37f42a8f1a22404d7d0579528af18f5dac7232cca6bdbd5117c115a0ad5,1370 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 8dff8f8f74..42a23df0c4 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -70,7 +70,7 @@ extra-deps: - uniplate-1.6.13 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 7dd356c9c0..444168f8ce 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -68,7 +68,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index da36dc3893..e00ef00c00 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -41,7 +41,7 @@ extra-deps: - ghc-source-gen-0.4.1.0 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hie-bios-0.7.6 -- hiedb-0.4.0.0 +- hiedb-0.4.1.0 - hspec-2.7.10 - hspec-core-2.7.10 - hspec-discover-2.7.10 diff --git a/stack.yaml b/stack.yaml index f3726ef63b..7c78883d27 100644 --- a/stack.yaml +++ b/stack.yaml @@ -51,7 +51,7 @@ extra-deps: - temporary-1.2.1.1 - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - - hiedb-0.4.0.0 + - hiedb-0.4.1.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 From 0da7def0fb7b4d82355bb2649da0150064a0edfd Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 2 Sep 2021 16:23:12 +0200 Subject: [PATCH 10/22] Use hspec < 2.8 again --- hls-test-utils/hls-test-utils.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index eb139c8908..dc25afb526 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -44,7 +44,7 @@ library , ghcide ^>=1.4 , hls-graph , hls-plugin-api ^>=1.2 - , hspec <2.9 + , hspec <2.8 , hspec-core , lens , lsp ^>=1.2 From 37a2f94a19c96bae903ee393fe02b69b1fc5c163 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 4 Sep 2021 12:01:26 +0200 Subject: [PATCH 11/22] Enable more tests for GHC 9.0.1 --- .github/workflows/test.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c96ae6ee42..c2b1d7e87a 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -178,7 +178,7 @@ jobs: name: Test hls-class-plugin run: cabal test hls-class-plugin --test-options="-j1 --rerun-update" || cabal test hls-class-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="-j1 --rerun" - - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test && matrix.ghc }} + - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }} name: Test hls-eval-plugin run: cabal test hls-eval-plugin --test-options="-j1 --rerun-update" || cabal test hls-eval-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="-j1 --rerun" @@ -186,7 +186,7 @@ jobs: name: Test hls-haddock-comments-plugin run: cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun-update" || cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun" - - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test && matrix.ghc != '9.0.1' }} + - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }} name: Test hls-splice-plugin run: cabal test hls-splice-plugin --test-options="-j1 --rerun-update" || cabal test hls-splice-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="-j1 --rerun" @@ -206,7 +206,7 @@ jobs: name: Test hls-tactics-plugin test suite run: cabal test hls-tactics-plugin --test-options="-j1 --rerun-update" || cabal test hls-tactics-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="-j1 --rerun" - - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test && matrix.ghc != '9.0.1' }} + - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }} name: Test hls-refine-imports-plugin test suite run: cabal test hls-refine-imports-plugin --test-options="-j1 --rerun-update" || cabal test hls-refine-imports-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="-j1 --rerun" From 81cc2d9497901e26ad5ccba106265fb14a3a1511 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 4 Sep 2021 12:11:39 +0200 Subject: [PATCH 12/22] Fix nix build --- cabal-ghc901.project | 2 +- configuration-ghc-901.nix | 34 ++++++++-------------------------- flake.nix | 11 +++++------ 3 files changed, 14 insertions(+), 33 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 1ae685a8e1..34331958de 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -64,7 +64,7 @@ write-ghc-environment-files: never index-state: 2021-09-06T12:12:22Z constraints: - -- These plugins doesn't work on GHC9 yet + -- These plugins don't work on GHC9 yet haskell-language-server -brittany -class -fourmolu -stylishhaskell -tactic allow-newer: diff --git a/configuration-ghc-901.nix b/configuration-ghc-901.nix index 79a04cf0ac..a6646abc49 100644 --- a/configuration-ghc-901.nix +++ b/configuration-ghc-901.nix @@ -7,9 +7,7 @@ let "hls-brittany-plugin" "hls-stylish-haskell-plugin" "hls-fourmolu-plugin" - "hls-splice-plugin" "hls-class-plugin" - "hls-refine-imports-plugin" ]; hpkgsOverride = hself: hsuper: @@ -23,23 +21,10 @@ let }; in { - # we need add ghc-api-compat to build depends, - # since its condition tree is not evaluated under ghc 9 - - ghc-api-compat = hself.callHackageDirect { - pkg = "ghc-api-compat"; - ver = "9.0.1"; - sha256 = "WCK1gu6iiCAc2s2rFEqn2CkvHkITPrmDjuiGsWOWerM="; - } {}; - - hiedb = addBuildDepend hsuper.hiedb hself.ghc-api-compat; - blaze-textual = hself.callCabal2nix "blaze-textual" - (pkgs.fetchFromGitHub { - owner = "jwaldmann"; - repo = "blaze-textual"; - rev = "d8ee6cf80e27f9619d621c936bb4bda4b99a183f"; - sha256 = "C0dIzf64fBaY8mlhMm1kCQC5Jc1wKBtNO2Y24k7YPUw="; + (builtins.fetchTarball { + url = "https://hackage.haskell.org/package/blaze-textual-0.2.2.1/blaze-textual-0.2.2.1.tar.gz"; + sha256 = "1lhzsraiw11ldxvxn8ax11hswpyzsvw2da2qmp3p6fc9rfpz4pj5"; }) { }; czipwith = hself.callCabal2nix "czipwith" (pkgs.fetchFromGitHub { @@ -49,12 +34,11 @@ let sha256 = "2uSoGyrxT/OstRcpx55kwP4JwjPbWLxD72LajeyQV0E="; }) { }; - hie-bios = hself.callCabal2nix "hie-bios" (pkgs.fetchFromGitHub { - owner = "jneira"; - repo = "hie-bios"; - rev = "9b1445ab5efcabfad54043fc9b8e50e9d8c5bbf3"; - sha256 = "8ct7t3xIxIAoC+f8VO5e5+QKrd5L5Zu1eButSaE+1Uk="; - }) { }; + hie-bios = hself.callCabal2nix "hie-bios" + (builtins.fetchTarball { + url = "https://hackage.haskell.org/package/hie-bios-0.7.6/hie-bios-0.7.6.tar.gz"; + sha256 = "1lhzsraiw11ldxvxn8ax11hswpyzsvw2da2qmp3p6fc9rfpz4pj5"; + }) { }; th-extras = hself.callCabal2nix "th-extras" (pkgs.fetchFromGitHub { owner = "anka-213"; @@ -100,10 +84,8 @@ let "-f-brittany" "-f-class" "-f-fourmolu" - "-f-splice" "-f-stylishhaskell" "-f-tactic" - "-f-refineImports" ]) { }; # YOLO diff --git a/flake.nix b/flake.nix index d5dc999ed1..5104b4ae33 100644 --- a/flake.nix +++ b/flake.nix @@ -70,12 +70,11 @@ # Don't use `callHackage`, it requires us to override `all-cabal-hashes` tweaks = hself: hsuper: with haskell.lib; { - - ghc-api-compat = hself.callHackageDirect { - pkg = "ghc-api-compat"; - ver = "8.10.7"; - sha256 = "g9/InDeQfiXCB9SK8mpl/8B5QEEobj9uqo4xe//telw="; - } {}; + hiedb = hself.callCabal2nix "hiedb" + (builtins.fetchTarball { + url = "https://hackage.haskell.org/package/hiedb-0.4.1.0/hiedb-0.4.1.0.tar.gz"; + sha256 = "11s7lfkd6fc3zf3kgyp3jhicbhxpn6jp0yjahl8d28hicwr2qdpi"; + }) { }; lsp = hself.lsp_1_2_0_1; From 95bfe28ee00a20639a15c24893f98b9be02056d7 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 5 Sep 2021 12:12:28 +0200 Subject: [PATCH 13/22] Fix nix build for GHC 9.0 --- configuration-ghc-901.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configuration-ghc-901.nix b/configuration-ghc-901.nix index a6646abc49..f10724f125 100644 --- a/configuration-ghc-901.nix +++ b/configuration-ghc-901.nix @@ -24,7 +24,7 @@ let blaze-textual = hself.callCabal2nix "blaze-textual" (builtins.fetchTarball { url = "https://hackage.haskell.org/package/blaze-textual-0.2.2.1/blaze-textual-0.2.2.1.tar.gz"; - sha256 = "1lhzsraiw11ldxvxn8ax11hswpyzsvw2da2qmp3p6fc9rfpz4pj5"; + sha256 = "1nyhc9mrnxsl21ksnpp0ryki4wgk49r581yy504g2gjq6x3bkb59"; }) { }; czipwith = hself.callCabal2nix "czipwith" (pkgs.fetchFromGitHub { @@ -37,7 +37,7 @@ let hie-bios = hself.callCabal2nix "hie-bios" (builtins.fetchTarball { url = "https://hackage.haskell.org/package/hie-bios-0.7.6/hie-bios-0.7.6.tar.gz"; - sha256 = "1lhzsraiw11ldxvxn8ax11hswpyzsvw2da2qmp3p6fc9rfpz4pj5"; + sha256 = "0w4rhy4b3jnci9m27l79c8n28wl56x49bmhdn7pvf88mx9srjcvq"; }) { }; th-extras = hself.callCabal2nix "th-extras" (pkgs.fetchFromGitHub { From fc75893f09b83504ae17741c40f9803dc4ee1952 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 5 Sep 2021 13:53:39 +0200 Subject: [PATCH 14/22] Update stack.yaml files --- stack-8.10.6.yaml | 47 +++++++++++++++-------------------------------- stack-8.10.7.yaml | 3 +-- 2 files changed, 16 insertions(+), 34 deletions(-) diff --git a/stack-8.10.6.yaml b/stack-8.10.6.yaml index 42166caea2..41bedc7cb9 100644 --- a/stack-8.10.6.yaml +++ b/stack-8.10.6.yaml @@ -31,39 +31,22 @@ ghc-options: "$everything": -haddock extra-deps: - - apply-refact-0.9.3.0 - - brittany-0.13.1.2 - - Cabal-3.0.2.0 - - clock-0.7.2 - - data-tree-print-0.1.0.2@rev:2 - - floskell-0.10.5 - - fourmolu-0.3.0.0 - - ghc-check-0.5.0.4 - - ghc-exactprint-0.6.4 - - ghc-source-gen-0.4.1.0 - - heapsize-0.3.0 - - implicit-hie-cradle-0.3.0.5 - - implicit-hie-0.1.2.6 - - monad-dijkstra-0.1.1.2 - # For stylish-haskell-0.12.2.0 - - optparse-applicative-0.15.1.0 - - refinery-0.4.0.0 - - retrie-1.0.0.0 - - stylish-haskell-0.12.2.0 - - semigroups-0.18.5 - - temporary-1.2.1.1 - - th-compat-0.1.2@sha256:3d55de1adc542c1a870c9ada90da2fbbe5f4e8bcd3eed545a55c3df9311b32a8,2854 - - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 + - brittany-0.13.1.2@sha256:9922614f1df18c63755a37c144033988788e0769fd9c2630b64ed0dfb49462bd,8197 + - bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738 + - data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 + - floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803 + - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hiedb-0.4.1.0 - - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 - - constraints-extras-0.3.1.0 - - some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055 - - unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - - lsp-1.2.0.1 - - lsp-types-1.3.0.1 - - lsp-test-0.14.0.1 + - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 + - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 + - lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431 + - lsp-test-0.14.0.1@sha256:efce2ddec4183390341db7667e63936954c654a14d809ad7b61e4010a2fde97e,4739 + - lsp-types-1.3.0.1@sha256:1dc41eb358345c1927fb8f285e7d951869623fe5b695fbbecf2fe6a3cee9fcfd,4646 + - monad-dijkstra-0.1.1.3@sha256:d2fc098d7c122555e726830a12ae0423ac187f89de9228f32e56e2f6fc2238e1,1900 + - optparse-applicative-0.15.1.0@sha256:29ff6146aabf54d46c4c8788e8d1eadaea27c94f6d360c690c5f6c93dac4b07e,4810 + - refinery-0.4.0.0@sha256:fe3a43add8ff1db5cfffee7e7694c86128b1dfe62c541f26e25a8eadf9585610,1663 + - retrie-1.0.0.0@sha256:82014773115807f649f60fe4a3246911bbccd063a3c846cf5665e71f237bdd2d,4241 + - stylish-haskell-0.12.2.0@sha256:38f7fd9ca30c9aad34f176dae4564576899e9c197b6b8557b59c5e8c6a622c74,6108 # Enable these when supported by all formatters # - ghc-lib-9.0.1.20210324@sha256:c8b9a2541ea3424c8d0e4f80584477d0f35be03f4a47d931152042d5f446c5fc,19279 diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml index 3959b71d80..fbaf2d380e 100644 --- a/stack-8.10.7.yaml +++ b/stack-8.10.7.yaml @@ -35,9 +35,8 @@ extra-deps: - bytestring-encoding-0.1.1.0@sha256:1c3b97eb6345fd7153006211c8272215cd78bb0cf440c41185290822f1e3f2c2,1738 - data-tree-print-0.1.0.2@sha256:d845e99f322df70e0c06d6743bf80336f5918d5423498528beb0593a2afc1703,1620 - floskell-0.10.5@sha256:77f0bc1569573d9666b10975a5357fef631d32266c071733739393ccae521dab,3803 - - ghc-api-compat-8.10.7 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - - hiedb-0.4.0.0@sha256:b6dadd5cefc8c1052bc4b29144f616ca9c22e863a96d8e447d66a4d32c96fd4a,2987 + - hiedb-0.4.1.0 - implicit-hie-0.1.2.6@sha256:f50a908979a574a881f753c0f9a5224f023f438b30fdefc5b7fa01803b07a280,2998 - implicit-hie-cradle-0.3.0.5@sha256:5f5e575f549b2a9db664be7650b5c3c9226e313bddc46c79e2e83eb349f8e692,2610 - lsp-1.2.0.1@sha256:5b37d26fcbf037434e257e953c08513d4cb125ed784d4611038905c72dc0f58c,5431 From 8a18b48766aefdfdf8590e1d1a6882003377b8c2 Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 6 Sep 2021 21:22:05 +0200 Subject: [PATCH 15/22] Use custom equality for SrcSpan Equality of 'SrcSpan' also considers its field 'Maybe BufSpan' which is wrong in a couple of cases. Fixes Splice Plugin --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 1 + ghcide/src/Development/IDE/GHC/ExactPrint.hs | 23 +++++++++++++------ .../src/Ide/Plugin/Splice.hs | 9 ++++---- 3 files changed, 21 insertions(+), 12 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index a1c4cdbf8e..957fcac4a8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -525,6 +525,7 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.RealSrcLoc, SrcLoc.SrcLoc(..), BufSpan, + SrcLoc.leftmost_smallest, SrcLoc.containsSpan, SrcLoc.mkGeneralSrcSpan, SrcLoc.mkRealSrcSpan, diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index b4d88cf201..c0adc509e8 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -29,6 +29,8 @@ module Development.IDE.GHC.ExactPrint Anns, Annotate, setPrecedingLinesT, + -- * Helper function + eqSrcSpan, ) where @@ -230,8 +232,9 @@ graft' needs_space dst val = Graft $ \dflags a -> do everywhere' ( mkT $ \case - (L src _ :: Located ast) | src == dst -> val' - l -> l + (L src _ :: Located ast) + | src `eqSrcSpan` dst -> val' + l -> l ) a @@ -264,7 +267,7 @@ getNeedsSpaceAndParenthesize dst a = let (needs_parens, needs_space) = everythingWithContext (Nothing, Nothing) (<>) ( mkQ (mempty, ) $ \x s -> case x of - (L src _ :: LHsExpr GhcPs) | src == dst -> + (L src _ :: LHsExpr GhcPs) | src `eqSrcSpan` dst -> (s, s) L _ x' -> (mempty, Just *** Just $ needsParensSpace x') ) a @@ -288,7 +291,7 @@ graftExprWithM dst trans = Graft $ \dflags a -> do ( mkM $ \case val@(L src _ :: LHsExpr GhcPs) - | src == dst -> do + | src `eqSrcSpan` dst -> do mval <- trans val case mval of Just val' -> do @@ -313,7 +316,7 @@ graftWithM dst trans = Graft $ \dflags a -> do ( mkM $ \case val@(L src _ :: Located ast) - | src == dst -> do + | src `eqSrcSpan` dst -> do mval <- trans val case mval of Just val' -> do @@ -365,7 +368,7 @@ graftDecls dst decs0 = Graft $ \dflags a -> do annotateDecl dflags decl let go [] = DL.empty go (L src e : rest) - | src == dst = DL.fromList decs <> DL.fromList rest + | src `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest | otherwise = DL.singleton (L src e) <> go rest modifyDeclsT (pure . DL.toList . go) a @@ -396,7 +399,7 @@ graftDeclsWithM :: graftDeclsWithM dst toDecls = Graft $ \dflags a -> do let go [] = pure DL.empty go (e@(L src _) : rest) - | src == dst = toDecls e >>= \case + | src `eqSrcSpan` dst = toDecls e >>= \case Just decs0 -> do decs <- forM decs0 $ \decl -> hoistTransform (either Fail.fail pure) $ @@ -516,3 +519,9 @@ render dflags = showSDoc dflags . ppr parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs parenthesize = parenthesizeHsExpr appPrec +------------------------------------------------------------------------------ + +-- | Equality on SrcSpan's. +-- Ignores the (Maybe BufSpan) field of SrcSpan's. +eqSrcSpan :: SrcSpan -> SrcSpan -> Bool +eqSrcSpan l r = leftmost_smallest l r == EQ diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 0d1beed8f7..45c6688d2b 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -209,11 +209,10 @@ setupHscEnv ideState fp pm = do let ps = annotateParsedSource pm hscEnv0 = hscEnvWithImportPaths hscEnvEq modSum = pm_mod_summary pm - df' <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum - let hscEnv = hscEnv0 { hsc_dflags = df' } - pure (ps, hscEnv, df') + hscEnv <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum + pure (ps, hscEnv, hsc_dflags hscEnv) -setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags +setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO HscEnv setupDynFlagsForGHCiLike env dflags = do let dflags3 = setInterpreterLinkerOptions dflags platform = targetPlatform dflags3 @@ -230,7 +229,7 @@ setupDynFlagsForGHCiLike env dflags = do `gopt_set` Opt_IgnoreOptimChanges `gopt_set` Opt_IgnoreHpcChanges `gopt_unset` Opt_DiagnosticsShowCaret - hsc_dflags <$> initializePlugins (hscSetFlags dflags4 env) + initializePlugins (hscSetFlags dflags4 env) adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit adjustToRange uri ran (WorkspaceEdit mhult mlt x) = From 654dca300598a58262ef95d336f6edf31b9e5f4d Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 7 Sep 2021 13:26:45 +0200 Subject: [PATCH 16/22] Prefer module re-exports over explicit listing of every identifier --- ghcide/src/Development/IDE/Core/Compile.hs | 66 +- .../src/Development/IDE/Core/Preprocessor.hs | 22 +- ghcide/src/Development/IDE/Core/Rules.hs | 4 +- ghcide/src/Development/IDE/GHC/Compat.hs | 71 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 722 +++++++----------- .../Development/IDE/GHC/Compat/Outputable.hs | 4 +- .../src/Development/IDE/GHC/Compat/Parser.hs | 3 + .../src/Development/IDE/GHC/Compat/Plugins.hs | 2 - ghcide/src/Development/IDE/GHC/ExactPrint.hs | 4 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 14 +- ghcide/src/Development/IDE/GHC/Util.hs | 111 +-- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 35 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 187 ++--- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 5 +- .../src/Wingman/Judgements.hs | 2 +- .../src/Wingman/Machinery.hs | 2 +- .../hls-tactics-plugin/src/Wingman/Naming.hs | 2 +- 17 files changed, 513 insertions(+), 743 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index daab5375c5..9f69150d53 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -36,7 +36,7 @@ import Development.IDE.Core.Preprocessor import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake import Development.IDE.GHC.Error -import Development.IDE.GHC.Orphans () +import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util import Development.IDE.GHC.Warnings import Development.IDE.Spans.Common @@ -44,71 +44,69 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options +import Development.IDE.GHC.Compat hiding (loadInterface, + parseHeader, + parseModule, tcRnModule, + writeHieFile) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Outputable -import Development.IDE.GHC.Compat hiding (writeHieFile, - parseModule, - loadInterface, - parseHeader) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat.Util as Util -import qualified Development.IDE.GHC.Compat as GHC +import qualified Development.IDE.GHC.Compat.Util as Util import HieDb -import Language.LSP.Types (DiagnosticTag (..)) +import Language.LSP.Types (DiagnosticTag (..)) -import Control.Monad.IO.Class #if MIN_VERSION_ghc(8,10,0) -import Control.DeepSeq (force, rnf) +import Control.DeepSeq (force, rnf) #else -import Control.DeepSeq (rnf) +import Control.DeepSeq (rnf) import ErrUtils #endif #if MIN_VERSION_ghc(9,0,1) -import GHC.Builtin.Names import GHC.Tc.Gen.Splice -import GHC.Tc.Types.Evidence (EvBind) #else -import PrelNames import TcSplice #endif -import Control.Exception (evaluate) +import Control.Exception (evaluate) import Control.Exception.Safe -import Control.Lens hiding (List) +import Control.Lens hiding (List) import Control.Monad.Except import Control.Monad.Extra import Control.Monad.Trans.Except -import Data.Bifunctor (first, second) -import qualified Data.ByteString as BS -import qualified Data.DList as DL +import Data.Bifunctor (first, second) +import qualified Data.ByteString as BS +import qualified Data.DList as DL import Data.IORef import Data.List.Extra -import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict as Map import Data.Maybe -import qualified Data.Text as T -import Data.Time (UTCTime, getCurrentTime) -import qualified GHC.LanguageExtensions as LangExt +import qualified Data.Text as T +import Data.Time (UTCTime, getCurrentTime) +import qualified GHC.LanguageExtensions as LangExt import System.Directory import System.FilePath -import System.IO.Extra (fixIO, newTempFileWithin) +import System.IO.Extra (fixIO, + newTempFileWithin) -- GHC API imports -import GHC (parsedSource, GetDocsFailure(..)) +import GHC (GetDocsFailure (..), + parsedSource) import Control.Concurrent.Extra -import Control.Concurrent.STM hiding (orElse) -import Data.Aeson (toJSON) +import Control.Concurrent.STM hiding (orElse) +import Data.Aeson (toJSON) import Data.Binary import Data.Coerce import Data.Functor -import qualified Data.HashMap.Strict as HashMap -import Data.Tuple.Extra (dupe) -import Data.Unique -import qualified Language.LSP.Server as LSP -import qualified Language.LSP.Types as LSP +import qualified Data.HashMap.Strict as HashMap +import Data.Tuple.Extra (dupe) +import Data.Unique as Unique +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'. parseModule @@ -547,7 +545,7 @@ indexHieFile se mod_summary srcPath !hash hf = do case lspEnv se of Nothing -> pure Nothing Just env -> LSP.runLspT env $ do - u <- LSP.ProgressTextToken . T.pack . show . hashUnique <$> liftIO newUnique + u <- LSP.ProgressTextToken . T.pack . show . hashUnique <$> liftIO Unique.newUnique -- TODO: Wait for the progress create response to use the token _ <- LSP.sendRequest LSP.SWindowWorkDoneProgressCreate (LSP.WorkDoneProgressCreateParams u) (const $ pure ()) LSP.sendNotification LSP.SProgress $ LSP.ProgressParams u $ diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 938879d062..bb958065db 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -8,25 +8,25 @@ module Development.IDE.Core.Preprocessor import Development.IDE.GHC.CPP import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Outputable -import qualified Development.IDE.GHC.Compat.Util as Util -import Development.IDE.GHC.Orphans () +import qualified Development.IDE.GHC.Compat.Util as Util +import Development.IDE.GHC.Orphans () -import Control.DeepSeq (NFData (rnf)) -import Control.Exception (evaluate) -import Control.Exception.Safe (catch, throw) -import Control.Monad.Trans.Except +import Control.DeepSeq (NFData (rnf)) +import Control.Exception (evaluate) +import Control.Exception.Safe (catch, throw) import Control.Monad.IO.Class +import Control.Monad.Trans.Except import Data.Char -import Data.IORef (IORef, modifyIORef, - newIORef, readIORef) +import Data.IORef (IORef, modifyIORef, + newIORef, readIORef) import Data.List.Extra import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as T import Development.IDE.GHC.Error import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location -import qualified GHC.LanguageExtensions as LangExt +import qualified GHC.LanguageExtensions as LangExt import System.FilePath import System.IO.Extra diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index a964b82a78..d4f4c30d81 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -58,6 +58,9 @@ module Development.IDE.Core.Rules( typeCheckRuleDefinition, ) where +#if !MIN_VERSION_ghc(8,8,0) +import Control.Applicative (liftA2) +#endif import Control.Concurrent.Async (concurrently) import Control.Concurrent.Strict import Control.Exception.Safe @@ -137,7 +140,6 @@ import Language.LSP.Types (SMethod (SCustomM import Language.LSP.VFS import System.Directory (canonicalizePath, makeAbsolute) -import Control.Applicative import Data.Default (def) import Ide.Plugin.Properties (HasProperty, KeyNameProxy, diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 293b9df225..948a854f80 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -14,39 +14,16 @@ module Development.IDE.GHC.Compat( addIncludePathsQuote, getModuleHash, setUpTypedHoles, - GHC.ModLocation, - Module.addBootSuffix, - pattern ModLocation, - ml_hs_file, - ml_obj_file, - ml_hi_file, - ml_hie_file, upNameCache, disableWarningsAsErrors, -#if MIN_VERSION_ghc(8,10,0) - module GHC.Hs.Extension, -#else - module HsExtension, - noExtField, -#endif - #if !MIN_VERSION_ghc(9,0,1) RefMap, #endif -#if MIN_VERSION_ghc(9,0,0) - IsBootInterface(..), -#else - pattern IsBoot, - pattern NotBoot, -#endif - nodeInfo', getNodeIds, - pprSigmaType, - isQualifiedImport, GhcVersion(..), ghcVersion, @@ -81,8 +58,6 @@ module Development.IDE.GHC.Compat( import GHC hiding (HasSrcSpan, ModLocation, getLoc, lookupName, RealSrcSpan) -import qualified GHC - import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface @@ -101,25 +76,14 @@ import GHC.Unit.Module.ModIface #else import GHC.Driver.Types #endif -import GHC.Hs.Extension import GHC.Iface.Env import GHC.Iface.Make (mkIfaceExports) import qualified GHC.SysTools.Tasks as SysTools -import GHC.Tc.Utils.TcType (pprSigmaType) import qualified GHC.Types.Avail as Avail -import qualified GHC.Unit.Module.Location as Module -import GHC.Unit.Types #else import DynFlags hiding (ExposePackage) -import qualified Module -import TcType (pprSigmaType) import HscTypes import MkIface hiding (writeIfaceFile) -#if MIN_VERSION_ghc(8,10,0) -import GHC.Hs.Extension -#else -import HsExtension -#endif import qualified Avail #if MIN_VERSION_ghc(8,8,0) @@ -129,7 +93,6 @@ import qualified SysTools #if !MIN_VERSION_ghc(8,8,0) import SrcLoc (RealLocated) -import System.FilePath ((-<.>)) import qualified EnumSet import Foreign.ForeignPtr @@ -145,15 +108,11 @@ import qualified Data.ByteString as BS import Data.IORef import qualified Data.Map as Map +import Data.List (foldl') #if MIN_VERSION_ghc(9,0,0) import qualified Data.Set as S #endif -#if MIN_VERSION_ghc(8,8,0) -import Data.List (foldl') -#else -import Data.List (foldl', isSuffixOf) -#endif #if !MIN_VERSION_ghc(8,8,0) hPutStringBuffer :: Handle -> StringBuffer -> IO () @@ -162,24 +121,12 @@ hPutStringBuffer hdl (StringBuffer buf len cur) hPutBuf hdl ptr len #endif -#if !MIN_VERSION_ghc(8,10,0) -noExtField :: NoExt -noExtField = noExt -#endif - supportsHieFiles :: Bool supportsHieFiles = True hieExportNames :: HieFile -> [(SrcSpan, Name)] hieExportNames = nameListFromAvails . hie_exports -#if !MIN_VERSION_ghc(8,8,0) -ml_hie_file :: GHC.ModLocation -> FilePath -ml_hie_file ml - | "boot" `isSuffixOf ` ml_hi_file ml = ml_hi_file ml -<.> ".hie-boot" - | otherwise = ml_hi_file ml -<.> ".hie" -#endif - upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c #if MIN_VERSION_ghc(8,8,0) upNameCache = updNameCache @@ -188,7 +135,6 @@ upNameCache ref upd_fn = atomicModifyIORef' ref upd_fn #endif - #if !MIN_VERSION_ghc(9,0,1) type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)] #endif @@ -215,15 +161,6 @@ addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags addIncludePathsQuote path x = x{includePaths = f $ includePaths x} where f i = i{includePathsQuote = path : includePathsQuote i} -pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation -#if MIN_VERSION_ghc(8,8,0) -pattern ModLocation a b c <- - GHC.ModLocation a b c _ where ModLocation a b c = GHC.ModLocation a b c "" -#else -pattern ModLocation a b c <- - GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c -#endif - setHieDir :: FilePath -> DynFlags -> DynFlags setHieDir _f d = #if MIN_VERSION_ghc(8,8,0) @@ -273,12 +210,6 @@ getModuleHash = mi_mod_hash . mi_final_exts getModuleHash = mi_mod_hash #endif -#if !MIN_VERSION_ghc(9,0,0) -pattern NotBoot, IsBoot :: IsBootInterface -pattern NotBoot = False -pattern IsBoot = True -#endif - disableWarningsAsErrors :: DynFlags -> DynFlags disableWarningsAsErrors df = diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 957fcac4a8..dcab251aed 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -3,7 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} -- TODO: remove -{-# OPTIONS -Wno-dodgy-imports #-} +{-# OPTIONS -Wno-dodgy-imports -Wno-unused-imports #-} -- | Compat Core module that handles the GHC module hierarchy re-organisation -- by re-exporting everything we care about. @@ -68,30 +68,6 @@ module Development.IDE.GHC.Compat.Core ( -- * Linear Haskell Scaled, scaledThing, - -- * UniqueSupply - UniqSupply, - takeUniqFromSupply, - mkSplitUniqSupply, - -- * ConLike - ConLike(..), - conLikeName, - conLikeFieldLabels, - conLikeFieldType, - conLikeIsInfix, - conLikeInstOrigArgTys, - conLikeResTy, - DataCon, - dataConFieldLabels, - dataConName, - dataConWrapId, - nilDataCon, - dataConCannotMatch, - isDataConName, - isTupleDataCon, - tupleDataCon, - consDataCon, - dataConIsInfix, - dataConInstSig, -- * Interface Files IfaceExport, IfaceTyCon(..), @@ -106,7 +82,6 @@ module Development.IDE.GHC.Compat.Core ( loadInterface, SourceModified(..), loadModuleInterface, - initIfaceLoad, RecompileRequired(..), #if MIN_VERSION_ghc(8,10,0) mkPartialIface, @@ -115,6 +90,12 @@ module Development.IDE.GHC.Compat.Core ( mkIface, #endif checkOldIface, +#if MIN_VERSION_ghc(9,0,0) + IsBootInterface(..), +#else + pattern IsBoot, + pattern NotBoot, +#endif -- * Fixity LexicalFixity(..), -- * ModSummary @@ -126,26 +107,7 @@ module Development.IDE.GHC.Compat.Core ( CgGuts(..), -- * ModDetails ModDetails(..), - -- * NameCache - NameCache, - initNameCache, - -- * NameEnv - NameEnv, - nameEnvElts, - mkNameEnv, - unitNameEnv, - extendNameEnv, - lookupNameEnv, - -- * NameSpace - isTcClsNameSpace, - -- * InstEnvs - InstEnvs(..), - lookupInstEnv, - -- * FamInstEnvs - FamInstEnvs, - normaliseType, -- * Var - Id, Type ( TyCoRep.TyVarTy, TyCoRep.AppTy, @@ -159,156 +121,16 @@ module Development.IDE.GHC.Compat.Core ( TyCoRep.CoercionTy ), pattern FunTy, - isPredTy, - isDictTy, - isForAllTy, - isFunTy, - isPiTy, - isBoolTy, - isFloatingTy, - isIntTy, - isIntegerTy, - isStringTy, -#if MIN_VERSION_ghc(8,10,0) - coercionKind, - isCoercionTy_maybe, -#else - isCoercionTy, - splitCoercionType_maybe, -#endif - substTyAddInScope, - piResultTys, - splitAppTys, - splitFunTys, - splitFunTy_maybe, - splitPiTys, Development.IDE.GHC.Compat.Core.splitForAllTyCoVars, - splitTyConApp_maybe, - TCvSubst, - extendTCvSubst, - emptyTCvSubst, - nonDetCmpType, - substTy, - unionTCvSubst, - zipTvSubst, - TyThing(..), - binderVar, - pprTyThingInContext, - pprTypeForUser, - TyVar, - setTyVarUnique, - getTyVar_maybe, - Var, - varType, - varName, - mkVarOcc, - setVarUnique, Development.IDE.GHC.Compat.Core.mkVisFunTys, - mkAppTys, - mkTyVarTy, - mkTyConTy, Development.IDE.GHC.Compat.Core.mkInfForAllTys, - charTy, - eqType, - tcView, - exprType, - isAlgType, - -- * Wired in types - unitDataConId, - charTyCon, - doubleTyCon, - floatTyCon, - intTyCon, - funTyCon, - alphaTy, - alphaTys, - alphaTyVar, - betaTy, - betaTyVar, - listTyCon, - maybeTyCon, - unitTyCon, - -- * TyCoVar - TyCoVar, - tyCoVarsOfTypeList, - tyCoVarsOfTypeWellScoped, - Development.IDE.GHC.Compat.Core.dataConExTyCoVars, - dataConOrigTyCon, - dataConInstArgTys, - -- * TyCon - TyCon, - tyConName, - tyConDataCons, - tyConClass_maybe, - eqPrimTyCon, -#if MIN_VERSION_ghc(8,8,0) - eqTyCon, -#endif - eqTyCon_RDR, - isTupleTyCon, - -- * Class - Class(..), - classMinimalDef, - classMethods, - classSCTheta, - -- * Id - idName, - idType, - -- * GlobalRdrEnv - GlobalRdrEnv, - GlobalRdrElt(..), - lookupGlobalRdrEnv, - globalRdrEnvElts, - lookupGRE_Name, - -- * OccEnv - OccEnv, - emptyOccEnv, - lookupOccEnv, -- * Specs ImpDeclSpec(..), ImportSpec(..), -- * SourceText SourceText(..), -- * Name -#if !MIN_VERSION_ghc(9,0,0) - NameOrRdrName, -#endif - Name, - isValName, - isSystemName, - isInternalName, - nameSrcSpan, - nameSrcLoc, - nameRdrName, - nameModule, - nameModule_maybe, - isQual, - isQual_maybe, - getSrcSpan, - RdrName(..), - mkRdrUnqual, - rdrNameFieldOcc, - HasOccName, - getOccName, - OccName(..), - occName, - nameOccName, - rdrNameOcc, - parenSymOcc, - isValOcc, - isVarOcc, - isDataOcc, - isSymOcc, - isTcOcc, - occNameString, - mkClsOcc, - mkVarOccFS, - pprNameDefnLoc, - Parent(..), tyThingParent_maybe, - -- * Field Occs - FieldOcc, - mkFieldOcc, -- * Ways Way, wayGeneralFlags, @@ -321,158 +143,22 @@ module Development.IDE.GHC.Compat.Core ( Avail.availName, Avail.availNames, Avail.availNamesWithSelectors, - -- * NameSet - NameSet, - FreeVars, - elemNameSet, - mkNameSet, Avail.availsToNameSet, -- * TcGblEnv TcGblEnv(..), - -- * Renamer stage - RnM, - rnTopSpliceDecls, - rnSplicePat, - rnSpliceType, - rnSpliceExpr, - -- * Rename Stage Names - findImportUsage, - getMinimalImports, - -- * FieldLabel - FieldLabel, - flSelector, - flLabel, - -- * Header Parser - getOptions, - -- * ErrUtils - Severity(..), - -- * Parsing and Expr types - P(..), - PState(..), - ParseResult(..), - getMessages, -#if MIN_VERSION_ghc(8,10,0) - getErrorMessages, -#endif + -- * Parsing and LExer types HsParsedModule(..), - ParsedModule(..), - ParsedSource, - RenamedSource, - HsModule(..), - LHsContext, - HsContext, - HsMatchContext(..), - LHsExpr, - HsExpr(..), - isAtomicHsExpr, - LIE, - IE(..), - ieName, - ieNames, - IEWrappedName(..), - IEWildcard(..), - LPat, - Pat(..), - ListPatTc(..), - LHsDecl, - HsDecl(..), - TyClDecl(..), - TyClGroup(..), - HsDataDefn(..), - ConDecl(..), - InstDecl(..), - ClsInst, - is_dfun, - ClsInstDecl(..), - DataFamInstDecl(..), - TyFamInstDecl(..), - FamEqn(..), - DerivDecl(..), - LRuleDecls, - RuleDecl(..), - LSig, - Sig(..), - DefaultDecl(..), - ForeignDecl(..), - WarnDecls(..), - AnnDecl(..), - RuleDecls(..), - SpliceDecl(..), - DocDecl(..), - RoleAnnotDecl(..), - FamilyDecl(..), - HsConDetails(..), - HsConDeclDetails, - LHsBinds, - LHsBind, - HsBind, - ABExport(..), - LHsBindLR, - HsBindLR(..), - PatSynBind(..), - HsGroup(..), - MatchGroup(..), - HsSplice(..), - LHsSigType, - LHsType, - HsType(..), - HsRecField, - HsRecField'(..), - HsRecFields(..), - LImportDecl, - ImportDecl(..), -#if MIN_VERSION_ghc(8,10,0) - ImportDeclQualifiedStyle(..), -#endif - HsWrapper(..), - HsWildCardBndrs(..), - HsImplicitBndrs(..), - LConDeclField, - ConDeclField(..), - HsValBindsLR(..), - NHsValBindsLR(..), - LMatch, - Match(..), - StmtLR(..), - GRHS(..), - GRHSs(..), - HsLocalBinds, - HsLocalBindsLR(..), -#if !MIN_VERSION_ghc(9,0,0) - UnboundVar(..), -#endif - parseHeader, - parseIdentifier, - parseModule, - parenthesizeHsExpr, - parenthesizeHsType, - parenthesizePat, - hsTypeNeedsParens, - sigPrec, - appPrec, - StringLiteral(..), - -- * Pat Syn - PatSyn, - mkPatSyn, - patSynBuilder, - patSynFieldLabels, - patSynIsInfix, - patSynMatcher, - patSynName, - patSynSig, - patSynExTyVars, - pprPatSynType, - -- * API Annotations - AnnKeywordId(..), - AnnotationComment(..), + GHC.ParsedModule(..), + GHC.ParsedSource, + GHC.RenamedSource, -- * Compilation Main HscEnv, - runGhc, + GHC.runGhc, unGhc, Session(..), modifySession, getSession, - setSessionDynFlags, + GHC.setSessionDynFlags, getSessionDynFlags, GhcMonad, Ghc, @@ -486,39 +172,20 @@ module Development.IDE.GHC.Compat.Core ( hscTypecheckRename, makeSimpleDetails, -- * Typecheck utils - TcM, - initTc, - initTcWithGbl, - tcLookup, - tcLookupDataFamInst_maybe, - tcSplitAppTys, - tcSplitPhiTy, - tcSplitTyConApp, - tcSplitTyConApp_maybe, - tcSplitFunTys, - tcSplitNestedSigmaTys, Development.IDE.GHC.Compat.Core.tcSplitForAllTyVars, Development.IDE.GHC.Compat.Core.tcSplitForAllTyVarBinder_maybe, - tcSplitSigmaTy, - TcTyThing(..), - tcTyConAppTyCon_maybe, - tcVisibleOrphanMods, - tcRnImportDecls, typecheckIface, mkIfaceTc, - finalSafeMode, - ImportAvails(..), ImportedModsVal(..), importedByUser, - collectHsBindsBinders, - TypecheckedSource, + GHC.TypecheckedSource, -- * Source Locations HasSrcSpan, - Located, - unLoc, + SrcLoc.Located, + SrcLoc.unLoc, getLoc, SrcLoc.RealLocated, - GenLocated(..), + SrcLoc.GenLocated(..), SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan), SrcLoc.RealSrcSpan, pattern RealSrcSpan, @@ -560,32 +227,13 @@ module Development.IDE.GHC.Compat.Core ( findObjectLinkableMaybe, InstalledFindResult(..), -- * Module and Package - Module, ModuleOrigin(..), PackageName(..), - ModuleName, - moduleName, - mkModuleName, - mkModule, - moduleNameFS, - moduleNameSlashes, - moduleNameString, - ModuleEnv, - moduleEnvElts, - emptyModuleEnv, - extendModuleEnv, - moduleEnvToList, - extendInstalledModuleEnv, -- * Linker Unlinked(..), Linkable(..), unload, initDynLinker, - -- * Doc Strings - extractDocs, - HsDocString, - DeclDocMap(..), - ArgDocMap(..), -- * Hooks Hooks, runMetaHook, @@ -596,17 +244,6 @@ module Development.IDE.GHC.Compat.Core ( metaRequestT, metaRequestD, metaRequestAW, - -- * Tidy - tcInitTidyEnv, - tidyOpenType, - mkBootModDetailsTc, - tidyProgram, - -- * PrelInfo - pRELUDE, - mkPrelImports, - knownKeyNames, - -- * Utils with no home, neither here nor in GHC - mkVarBind, -- * HPT addToHpt, addListToHpt, @@ -618,57 +255,180 @@ module Development.IDE.GHC.Compat.Core ( initObjLinker, loadDLL, InteractiveImport(..), - getContext, - setContext, - parseImportDecl, - runDecls, + GHC.getContext, + GHC.setContext, + GHC.parseImportDecl, + GHC.runDecls, Warn(..), - -- * Desugared - dsExpr, - initDs, - -- * PredType - PredType, - ThetaType, + -- * ModLocation + GHC.ModLocation, + pattern ModLocation, + Module.ml_hs_file, + Module.ml_obj_file, + Module.ml_hi_file, + Development.IDE.GHC.Compat.Core.ml_hie_file, + -- * DataCon + Development.IDE.GHC.Compat.Core.dataConExTyCoVars, -- * Role Role(..), - -- * Module extraction - extractModule, - -- * Ppr utils - showToHeader, - pprDefinedAt, - pprInfixName, -- * Panic panic, + -- * Util Module re-exports +#if MIN_VERSION_ghc(9,0,0) + module GHC.Builtin.Names, + module GHC.Builtin.Types, + module GHC.Builtin.Types.Prim, + module GHC.Builtin.Utils, + module GHC.Core.Class, + module GHC.Core.Coercion, + module GHC.Core.ConLike, + module GHC.Core.DataCon, + module GHC.Core.FamInstEnv, + module GHC.Core.InstEnv, +#if !MIN_VERSION_ghc(9,2,0) + module GHC.Core.Ppr.TyThing, +#endif + module GHC.Core.PatSyn, + module GHC.Core.Predicate, + module GHC.Core.TyCon, + module GHC.Core.TyCo.Ppr, + module GHC.Core.Type, + module GHC.Core.Utils, + + module GHC.HsToCore.Docs, + module GHC.HsToCore.Expr, + module GHC.HsToCore.Monad, + + module GHC.Iface.Tidy, + module GHC.Iface.Syntax, + module GHC.Rename.Names, + module GHC.Rename.Splice, + + module GHC.Tc.Instance.Family, + module GHC.Tc.Module, + module GHC.Tc.Types, + module GHC.Tc.Types.Evidence, + module GHC.Tc.Utils.Env, + module GHC.Tc.Utils.Monad, + + module GHC.Types.Basic, + module GHC.Types.Id, + module GHC.Types.Name , + module GHC.Types.Name.Set, + + module GHC.Types.Name.Cache, + module GHC.Types.Name.Env, + module GHC.Types.Name.Reader, +#if MIN_VERSION_ghc(9,2,0) + module GHC.Types.SourceFile, + module GHC.Types.SourceText, + module GHC.Types.TyThing, + module GHC.Types.TyThing.Ppr, +#endif + module GHC.Types.Unique.Supply, + module GHC.Types.Var, + module GHC.Unit.Module, + module GHC.Utils.Error, +#else + module BasicTypes, + module Class, +#if MIN_VERSION_ghc(8,10,0) + module Coercion, + module Predicate, +#endif + module ConLike, + module CoreUtils, + module DataCon, + module DsExpr, + module DsMonad, + module ErrUtils, + module FamInst, + module FamInstEnv, + module HeaderInfo, + module Id, + module InstEnv, + module IfaceSyn, + module Module, + module Name, + module NameCache, + module NameEnv, + module NameSet, + module PatSyn, + module PprTyThing, + module PrelInfo, + module PrelNames, + module RdrName, + module RnSplice, + module RnNames, + module TcEnv, + module TcEvidence, + module TcType, + module TcRnTypes, + module TcRnDriver, + module TcRnMonad, + module TidyPgm, + module TyCon, + module TysPrim, + module TysWiredIn, + module Type, + module UniqSupply, + module Var, +#endif + -- * Syntax re-exports +#if MIN_VERSION_ghc(9,0,0) + module GHC.Hs, + module GHC.Parser, + module GHC.Parser.Header, + module GHC.Parser.Lexer, +#else +#if MIN_VERSION_ghc(8,10,0) + module GHC.Hs, +#else + module HsBinds, + module HsDecls, + module HsDoc, + module HsExtension, + noExtField, + module HsExpr, + module HsImpExp, + module HsLit, + module HsPat, + module HsSyn, + module HsTypes, + module HsUtils, +#endif + module ExtractDocs, + module Parser, + module Lexer, +#endif ) where -import GHC hiding (HasSrcSpan, ModLocation, - Phase, RealSrcSpan, exprType, - getLoc, lookupName, moduleUnitId, - parseModule) +import qualified GHC #if MIN_VERSION_ghc(9,0,0) -import qualified GHC -import GHC.Builtin.Names +import GHC.Builtin.Names hiding (Unique, printName) import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Builtin.Utils import GHC.Core.Class import GHC.Core.Coercion import GHC.Core.ConLike -import GHC.Core.DataCon as DataCon +import GHC.Core.DataCon hiding (dataConExTyCoVars) +import qualified GHC.Core.DataCon as DataCon import GHC.Core.FamInstEnv import GHC.Core.InstEnv #if MIN_VERSION_ghc(9,2,0) import GHC.Core.Multiplicity (scaledThing) #else -import GHC.Core.Ppr.TyThing +import GHC.Core.Ppr.TyThing hiding (pprFamInst) import GHC.Core.TyCo.Rep (scaledThing) #endif import GHC.Core.PatSyn import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Core.TyCon -import GHC.Core.Type as TcType +import GHC.Core.Type hiding (mkInfForAllTys, mkVisFunTys) import GHC.Core.Utils #if MIN_VERSION_ghc(9,2,0) @@ -687,6 +447,9 @@ import GHC.Driver.Pipeline import GHC.Driver.Plugins import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Driver.Session as DynFlags +#if !MIN_VERSION_ghc(9,2,0) +import GHC.Hs +#endif import GHC.HsToCore.Docs import GHC.HsToCore.Expr import GHC.HsToCore.Monad @@ -698,7 +461,7 @@ import GHC.Iface.Syntax import GHC.Iface.Tidy import GHC.IfaceToCore import GHC.Parser -import GHC.Parser.Header +import GHC.Parser.Header hiding (getImports) import GHC.Parser.Lexer #if MIN_VERSION_ghc(9,2,0) import GHC.Linker.Loader @@ -713,9 +476,11 @@ import GHC.Runtime.Interpreter import GHC.Tc.Instance.Family import GHC.Tc.Module import GHC.Tc.Types -import GHC.Tc.Types.Evidence +import GHC.Tc.Types.Evidence hiding ((<.>)) import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Monad +import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, + MonadFix (..), MonadIO (..), allM, + anyM, concatMapM, mapMaybeM, (<$>)) import GHC.Tc.Utils.TcType as TcType import qualified GHC.Types.Avail as Avail #if MIN_VERSION_ghc(9,2,0) @@ -737,16 +502,20 @@ import GHC.Types.TyThing.Ppr #else import GHC.Types.Name.Set #endif -import GHC.Types.SrcLoc (BufSpan) +import GHC.Types.SrcLoc (BufSpan, SrcSpan (UnhelpfulSpan)) import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique.Supply -import GHC.Types.Var +import GHC.Types.Var (Var (varName), setTyVarUnique, + setVarUnique) #if MIN_VERSION_ghc(9,2,0) import GHC.Unit.Finder import GHC.Unit.Home.ModInfo #endif import GHC.Unit.Info (PackageName (..)) -import GHC.Unit.Module +import GHC.Unit.Module hiding (ModLocation (..), UnitId, + addBootSuffixLocnOut, moduleUnit, + toUnitId) +import qualified GHC.Unit.Module as Module #if MIN_VERSION_ghc(9,2,0) import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails @@ -754,46 +523,61 @@ import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface (IfaceExport) #endif import GHC.Unit.State (ModuleOrigin (..)) +import GHC.Utils.Error (Severity (..)) import GHC.Utils.Panic hiding (try) #else -import ConLike -import DataCon -import DynFlags hiding (ExposePackage) -import qualified DynFlags -import Finder -import Module -#if MIN_VERSION_ghc(9,0,1) -import GHC.Core.TyCo.Ppr (pprSigmaType) -import GHC.Core.TyCo.Rep (Scaled, scaledThing) -import GHC.Iface.Load -import GHC.Types.Unique.Set (emptyUniqSet) -import Module (unitString) -#endif import qualified Avail -import BasicTypes +import BasicTypes hiding (Version) import Class import CmdLineParser (Warn (..)) -import CoreUtils (exprType) +import ConLike +import CoreUtils +import DataCon hiding (dataConExTyCoVars) +import qualified DataCon import DriverPhases import DriverPipeline import DsExpr -import DsMonad -import ExtractDocs (extractDocs) +import DsMonad hiding (foldrM) +import DynFlags hiding (ExposePackage) +import qualified DynFlags +import ErrUtils hiding (logInfo, mkWarnMsg) +import ExtractDocs import FamInst import FamInstEnv +import Finder +#if MIN_VERSION_ghc(8,10,0) +import GHC.Hs +#endif import GHCi import GhcMonad -import HeaderInfo +import HeaderInfo hiding (getImports) import Hooks import HscMain import HscTypes +#if !MIN_VERSION_ghc(8,10,0) +-- Syntax imports +import HsBinds +import HsDecls +import HsDoc +import HsExpr +import HsExtension +import HsImpExp +import HsLit +import HsPat +import HsSyn hiding (wildCardName) +import HsTypes hiding (wildCardName) +import HsUtils +#endif import Id import IfaceSyn import InstEnv -import Lexer +import Lexer hiding (getSrcLoc) import Linker import LoadIface import MkIface +import Module hiding (ModLocation (..), UnitId, + addBootSuffixLocnOut, moduleUnitId) +import qualified Module import Name hiding (varName) import NameCache import NameEnv @@ -805,27 +589,34 @@ import PatSyn #if MIN_VERSION_ghc(8,8,0) import Plugins #endif -import PprTyThing +import PprTyThing hiding (pprFamInst) import PrelInfo -import PrelNames +import PrelNames hiding (Unique, printName) import RdrName import RnNames import RnSplice +import SrcLoc (SrcSpan (UnhelpfulSpan)) import qualified SrcLoc import TcEnv -import TcEvidence +import TcEvidence hiding ((<.>)) import TcIface import TcRnDriver -import TcRnMonad -import TcType +import TcRnMonad hiding (Applicative (..), IORef, + MonadFix (..), MonadIO (..), allM, + anyM, concatMapM, foldrM, + mapMaybeM, (<$>)) +import TcRnTypes +import TcType hiding (mkVisFunTys) +import qualified TcType import TidyPgm import qualified TyCoRep import TyCon -import Type +import Type hiding (mkVisFunTys) import TysPrim import TysWiredIn import UniqSupply -import Var +import Var (Var (varName), setTyVarUnique, + setVarUnique, varType) #if MIN_VERSION_ghc(8,10,0) import Coercion (coercionKind) @@ -835,6 +626,10 @@ import SrcLoc (RealLocated) #endif #endif +#if !MIN_VERSION_ghc(8,8,0) +import Data.List (isSuffixOf) +import System.FilePath +#endif #if !MIN_VERSION_ghc(9,0,0) type BufSpan = () @@ -901,7 +696,7 @@ pattern FunTy arg res <- TyCoRep.FunTy arg res class HasSrcSpan a where getLoc :: a -> SrcSpan -instance HasSrcSpan (GenLocated SrcSpan a) where +instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where getLoc = GHC.getLoc -- getLoc :: GenLocated l a -> l @@ -909,7 +704,7 @@ instance HasSrcSpan (GenLocated SrcSpan a) where #elif MIN_VERSION_ghc(8,8,0) type HasSrcSpan = SrcLoc.HasSrcSpan -getLoc :: SrcLoc.HasSrcSpan a => a -> SrcSpan +getLoc :: SrcLoc.HasSrcSpan a => a -> SrcLoc.SrcSpan getLoc = SrcLoc.getLoc #else @@ -918,25 +713,32 @@ class HasSrcSpan a where getLoc :: a -> SrcSpan instance HasSrcSpan Name where getLoc = nameSrcSpan -instance HasSrcSpan (GenLocated SrcSpan a) where +instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where getLoc = SrcLoc.getLoc #endif +getRealSrcSpan :: SrcLoc.RealLocated a -> SrcLoc.RealSrcSpan #if !MIN_VERSION_ghc(8,8,0) +getRealSrcSpan = SrcLoc.getLoc +#else +getRealSrcSpan = SrcLoc.getRealSrcSpan +#endif + -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself -addBootSuffixLocnOut :: ModLocation -> ModLocation +addBootSuffixLocnOut :: GHC.ModLocation -> GHC.ModLocation +#if !MIN_VERSION_ghc(8,8,0) addBootSuffixLocnOut locn - = locn { ml_hi_file = Module.addBootSuffix (ml_hi_file locn) - , ml_obj_file = Module.addBootSuffix (ml_obj_file locn) + = locn { Module.ml_hi_file = Module.addBootSuffix (Module.ml_hi_file locn) + , Module.ml_obj_file = Module.addBootSuffix (Module.ml_obj_file locn) } - -getRealSrcSpan :: RealLocated a -> SrcLoc.RealSrcSpan -getRealSrcSpan = SrcLoc.getLoc +#else +addBootSuffixLocnOut = Module.addBootSuffixLocnOut #endif + dataConExTyCoVars :: DataCon -> [TyCoVar] #if __GLASGOW_HASKELL__ >= 808 dataConExTyCoVars = DataCon.dataConExTyCoVars @@ -992,3 +794,31 @@ tcSplitForAllTyVarBinder_maybe = tcSplitForAllTy_maybe #endif +pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation +#if MIN_VERSION_ghc(8,8,0) +pattern ModLocation a b c <- + GHC.ModLocation a b c _ where ModLocation a b c = GHC.ModLocation a b c "" +#else +pattern ModLocation a b c <- + GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c +#endif + +#if !MIN_VERSION_ghc(8,10,0) +noExtField :: GHC.NoExt +noExtField = GHC.noExt +#endif + +ml_hie_file :: GHC.ModLocation -> FilePath +#if !MIN_VERSION_ghc(8,8,0) +ml_hie_file ml + | "boot" `isSuffixOf ` Module.ml_hi_file ml = Module.ml_hi_file ml -<.> ".hie-boot" + | otherwise = Module.ml_hi_file ml -<.> ".hie" +#else +ml_hie_file = Module.ml_hie_file +#endif + +#if !MIN_VERSION_ghc(9,0,0) +pattern NotBoot, IsBoot :: IsBootInterface +pattern NotBoot = False +pattern IsBoot = True +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 1b2d1fb14c..2092caf4f3 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -53,6 +53,7 @@ import GHC.Utils.Error as Err hiding (mkWarnMsg) import qualified GHC.Utils.Error as Err import GHC.Utils.Outputable as Out #else +import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) import DynFlags import ErrUtils hiding (mkWarnMsg) import qualified ErrUtils as Err @@ -61,9 +62,6 @@ import Outputable as Out import SrcLoc #endif -import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) - - printNameWithoutUniques :: Outputable a => a -> String printNameWithoutUniques = #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 21440a5346..450b0cf5ec 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -17,6 +17,9 @@ module Development.IDE.GHC.Compat.Parser ( mkHsParsedModule, mkParsedModule, mkApiAnns, + -- * API Annotations + Anno.AnnKeywordId(..), + Anno.AnnotationComment(..), ) where #if MIN_VERSION_ghc(9,0,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index f7b0793337..6621b70e9c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -21,8 +21,6 @@ import GHC #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Env as Env -#else -import GHC.Driver.Session (staticPlugins) #endif import GHC.Driver.Plugins (Plugin (..), PluginWithArgs (..), diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index c0adc509e8..96496e0967 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -54,7 +54,9 @@ import Data.Traversable (for) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (parseImport, + parsePattern, + parseType) import Development.IDE.GHC.Compat.Outputable import Development.IDE.Graph (RuleResult, Rules) import Development.IDE.Graph.Classes diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 1483d1cdc4..a04fd1e86d 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -10,14 +10,14 @@ module Development.IDE.GHC.Orphans() where #if MIN_VERSION_ghc(9,0,0) -import GHC.Data.Bag -import GHC.Data.FastString +import GHC.Data.Bag +import GHC.Data.FastString import qualified GHC.Data.StringBuffer as SB -import GHC.Types.Name.Occurrence -import GHC.Types.SrcLoc -import GHC.Types.Unique (getKey, getUnique) -import GHC.Unit.Info -import GHC.Utils.Outputable +import GHC.Types.Name.Occurrence +import GHC.Types.SrcLoc +import GHC.Types.Unique (getKey) +import GHC.Unit.Info +import GHC.Utils.Outputable #else import Bag import GhcPlugins diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index cd660b3db6..33fd105b10 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -10,7 +10,7 @@ module Development.IDE.GHC.Util( prettyPrint, unsafePrintSDoc, printRdrName, - printName, + Development.IDE.GHC.Util.printName, ParseResult(..), runParser, lookupPackageConfig, textToStringBuffer, @@ -31,72 +31,73 @@ module Development.IDE.GHC.Util( ) where #if MIN_VERSION_ghc(9,2,0) -import GHC -import GHC.Core.Multiplicity -import qualified GHC.Core.TyCo.Rep as TyCoRep -import GHC.Data.StringBuffer -import GHC.Data.FastString -import GHC.Driver.Env -import GHC.Driver.Env.Types -import GHC.Driver.Monad -import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags -import GHC.Hs.Extension -import qualified GHC.Hs.Type as GHC -import GHC.Iface.Env (updNameCache) -import GHC.Iface.Make (mkIfaceExports) -import qualified GHC.Linker.Types as LinkerTypes -import GHC.Parser.Lexer -import GHC.Unit.Env -import GHC.Unit.Info (PackageName) -import qualified GHC.Unit.Info as Packages -import GHC.Unit.Module.ModDetails -import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (mi_mod_hash) -import GHC.Unit.Module.Name (moduleNameSlashes) -import qualified GHC.Unit.Module.Location as Module -import qualified GHC.Unit.Types as Module -import GHC.Unit.Types (unitString, IsBootInterface(..)) -import qualified GHC.Unit.State as Packages -import GHC.Utils.Outputable -import qualified GHC.Utils.Outputable as Outputable -import GHC.Utils.Fingerprint -import GHC.Runtime.Context -import GHC.Tc.Types (TcGblEnv(tcg_exports)) -import GHC.Tc.Utils.TcType (pprSigmaType) -import GHC.Types.Avail -import GHC.Types.Name.Reader -import GHC.Types.Name.Cache -import GHC.Types.Name.Occurrence -import GHC.Types.SrcLoc -import qualified GHC.Types.SrcLoc as SrcLoc -#endif import GHC +import GHC.Core.Multiplicity +import qualified GHC.Core.TyCo.Rep as TyCoRep +import GHC.Data.FastString +import GHC.Data.StringBuffer +import GHC.Driver.Env +import GHC.Driver.Env.Types +import GHC.Driver.Monad +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags +import GHC.Hs.Extension +import qualified GHC.Hs.Type as GHC +import GHC.Iface.Env (updNameCache) +import GHC.Iface.Make (mkIfaceExports) +import qualified GHC.Linker.Types as LinkerTypes +import GHC.Parser.Lexer +import GHC.Runtime.Context +import GHC.Tc.Types (TcGblEnv (tcg_exports)) +import GHC.Tc.Utils.TcType (pprSigmaType) +import GHC.Types.Avail +import GHC.Types.Name.Cache +import GHC.Types.Name.Occurrence +import GHC.Types.Name.Reader +import GHC.Types.SrcLoc +import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Unit.Env +import GHC.Unit.Info (PackageName) +import qualified GHC.Unit.Info as Packages +import qualified GHC.Unit.Module.Location as Module +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModGuts +import GHC.Unit.Module.ModIface (mi_mod_hash) +import GHC.Unit.Module.Name (moduleNameSlashes) +import qualified GHC.Unit.State as Packages +import GHC.Unit.Types (IsBootInterface (..), + unitString) +import qualified GHC.Unit.Types as Module +import GHC.Utils.Fingerprint +import GHC.Utils.Outputable +import qualified GHC.Utils.Outputable as Outputable +#endif import Control.Concurrent -import Control.Exception as E -import Data.Binary.Put (Put, runPut) -import qualified Data.ByteString as BS -import Data.ByteString.Internal (ByteString (..)) -import qualified Data.ByteString.Internal as BS -import qualified Data.ByteString.Lazy as LBS +import Control.Exception as E +import Data.Binary.Put (Put, runPut) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (ByteString (..)) +import qualified Data.ByteString.Internal as BS +import qualified Data.ByteString.Lazy as LBS import Data.IORef import Data.List.Extra import Data.Maybe -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Encoding.Error as T +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Encoding.Error as T import Data.Typeable -import Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Outputable +import qualified Development.IDE.GHC.Compat.Parser as Compat +import qualified Development.IDE.GHC.Compat.Units as Compat import Development.IDE.GHC.Compat.Util -import qualified Development.IDE.GHC.Compat.Units as Compat -import qualified Development.IDE.GHC.Compat.Parser as Compat import Development.IDE.Types.Location import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable -import GHC.IO.BufferedIO (BufferedIO) -import GHC.IO.Device as IODevice +import GHC +import GHC.IO.BufferedIO (BufferedIO) +import GHC.IO.Device as IODevice import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index aa8d1bad60..efda6b23b9 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -11,24 +11,25 @@ module Development.IDE.Types.HscEnvEq ) where -import Control.Concurrent.Async (Async, async, waitCatch) -import Control.Concurrent.Strict (modifyVar, newVar) -import Control.DeepSeq (force) -import Control.Exception (evaluate, mask, throwIO) -import Control.Monad.Extra (eitherM, join, mapMaybeM) +import Control.Concurrent.Async (Async, async, waitCatch) +import Control.Concurrent.Strict (modifyVar, newVar) +import Control.DeepSeq (force) +import Control.Exception (evaluate, mask, throwIO) +import Control.Monad.Extra (eitherM, join, mapMaybeM) import Control.Monad.IO.Class -import Data.Either (fromRight) -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Unique +import Data.Either (fromRight) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Unique (Unique) +import qualified Data.Unique as Unique import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Maybes -import Development.IDE.GHC.Error (catchSrcErrors) -import Development.IDE.GHC.Util (lookupPackageConfig) +import Development.IDE.GHC.Error (catchSrcErrors) +import Development.IDE.GHC.Util (lookupPackageConfig) import Development.IDE.Graph.Classes -import Development.IDE.Types.Exports (ExportsMap, createExportsMap) -import OpenTelemetry.Eventlog (withSpan) -import System.Directory (canonicalizePath) +import Development.IDE.Types.Exports (ExportsMap, createExportsMap) +import OpenTelemetry.Eventlog (withSpan) +import System.Directory (canonicalizePath) import System.FilePath -- | An 'HscEnv' with equality. Two values are considered equal @@ -68,7 +69,7 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do let dflags = hsc_dflags hscEnv - envUnique <- newUnique + envUnique <- Unique.newUnique -- it's very important to delay the package exports computation envPackageExports <- onceAsync $ withSpan "Package Exports" $ \_sp -> do @@ -121,7 +122,7 @@ removeImportPaths :: HscEnv -> HscEnv removeImportPaths hsc = hscSetFlags (setImportPaths [] (hsc_dflags hsc)) hsc instance Show HscEnvEq where - show HscEnvEq{envUnique} = "HscEnvEq " ++ show (hashUnique envUnique) + show HscEnvEq{envUnique} = "HscEnvEq " ++ show (Unique.hashUnique envUnique) instance Eq HscEnvEq where a == b = envUnique a == envUnique b @@ -129,7 +130,7 @@ instance Eq HscEnvEq where instance NFData HscEnvEq where rnf (HscEnvEq a b c d _ _) = -- deliberately skip the package exports map and visible module names - rnf (hashUnique a) `seq` b `seq` c `seq` rnf d + rnf (Unique.hashUnique a) `seq` b `seq` c `seq` rnf d instance Hashable HscEnvEq where hashWithSalt s = hashWithSalt s . envUnique diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 758ed4441f..6ef585d8f1 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -25,104 +25,109 @@ module Ide.Plugin.Eval.CodeLens ( evalCommand, ) where -import Control.Applicative (Alternative ((<|>))) -import Control.Arrow (second, (>>>)) -import Control.Exception (try) -import qualified Control.Exception as E -import Control.Lens (_1, _3, (%~), (<&>), - (^.)) -import Control.Monad (guard, join, void, when) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Except (ExceptT (..)) -import Data.Aeson (toJSON) -import Data.Char (isSpace) -import qualified Data.DList as DL -import qualified Data.HashMap.Strict as HashMap -import Data.List (dropWhileEnd, find, - intercalate, intersperse) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe) -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (getCurrentTime) -import Data.Typeable (Typeable) -import Development.IDE (Action, - GetDependencies (..), - GetModIface (..), - GetModSummary (..), - GetParsedModuleWithComments (..), - GhcSessionIO (..), - HiFileResult (hirHomeMod, hirModSummary), - HscEnvEq, IdeState, - ModSummaryResult (..), - evalGhcEnv, - hscEnvWithImportPaths, - prettyPrint, - realSrcSpanToRange, - runAction, - textToStringBuffer, - toNormalizedFilePath', - uriToFilePath', - useNoFile_, - useWithStale_, use_, - uses_) -import Development.IDE.Core.Compile (loadModulesHome, - setupFinderCache) -import Development.IDE.Core.PositionMapping (toCurrentRange) -import Development.IDE.Core.Rules (TransitiveDependencies (transitiveModuleDeps)) -import Development.IDE.GHC.Compat hiding (unitState) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat as SrcLoc -import Development.IDE.GHC.Compat.Util (GhcException, OverridingBool(..)) -import qualified Development.IDE.GHC.Compat.Util as FastString +import Control.Applicative (Alternative ((<|>))) +import Control.Arrow (second, (>>>)) +import Control.Exception (try) +import qualified Control.Exception as E +import Control.Lens (_1, _3, (%~), (<&>), + (^.)) +import Control.Monad (guard, join, void, when) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Except (ExceptT (..)) +import Data.Aeson (toJSON) +import Data.Char (isSpace) +import qualified Data.DList as DL +import qualified Data.HashMap.Strict as HashMap +import Data.List (dropWhileEnd, find, + intercalate, + intersperse) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, fromMaybe) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (getCurrentTime) +import Data.Typeable (Typeable) +import Development.IDE (Action, + GetDependencies (..), + GetModIface (..), + GetModSummary (..), + GetParsedModuleWithComments (..), + GhcSessionIO (..), + HiFileResult (hirHomeMod, hirModSummary), + HscEnvEq, IdeState, + ModSummaryResult (..), + evalGhcEnv, + hscEnvWithImportPaths, + prettyPrint, + realSrcSpanToRange, + runAction, + textToStringBuffer, + toNormalizedFilePath', + uriToFilePath', + useNoFile_, + useWithStale_, use_, + uses_) +import Development.IDE.Core.Compile (loadModulesHome, + setupFinderCache) +import Development.IDE.Core.PositionMapping (toCurrentRange) +import Development.IDE.Core.Rules (TransitiveDependencies (transitiveModuleDeps)) +import Development.IDE.GHC.Compat hiding (typeKind, + unitState) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as SrcLoc import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat.Util (GhcException, + OverridingBool (..)) +import qualified Development.IDE.GHC.Compat.Util as FastString import Development.IDE.Types.Options -import GHC (ClsInst, - ExecOptions (execLineNumber, execSourceFile), - FamInst, Fixity, - GhcMonad, - LoadHowMuch (LoadAllTargets), - NamedThing (getName), - SuccessFlag (Failed, Succeeded), - TcRnExprMode (..), defaultFixity, - execOptions, exprType, - getInfo, - getInteractiveDynFlags, - isImport, isStmt, load, - parseName, pprFamInst, - pprInstance, setLogAction, - setTargets, typeKind) -import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) - -import Ide.Plugin.Eval.Code (Statement, asStatements, - evalSetup, myExecStmt, - propSetup, resultRange, - testCheck, testRanges) -import Ide.Plugin.Eval.GHC (addImport, addPackages, - hasPackage, showDynFlags) -import Ide.Plugin.Eval.Parse.Comments (commentsToSections) -import Ide.Plugin.Eval.Parse.Option (parseSetFlags) +import GHC (ClsInst, + ExecOptions (execLineNumber, execSourceFile), + FamInst, GhcMonad, + LoadHowMuch (LoadAllTargets), + NamedThing (getName), + defaultFixity, + execOptions, exprType, + getInfo, + getInteractiveDynFlags, + isImport, isStmt, load, + parseName, pprFamInst, + pprInstance, + setLogAction, + setTargets, typeKind) +import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) + +import Ide.Plugin.Eval.Code (Statement, asStatements, + evalSetup, myExecStmt, + propSetup, resultRange, + testCheck, testRanges) +import Ide.Plugin.Eval.GHC (addImport, addPackages, + hasPackage, + showDynFlags) +import Ide.Plugin.Eval.Parse.Comments (commentsToSections) +import Ide.Plugin.Eval.Parse.Option (parseSetFlags) import Ide.Plugin.Eval.Types -import Ide.Plugin.Eval.Util (asS, gStrictTry, - handleMaybe, - handleMaybeM, isLiterate, - logWith, response, - response', timed) +import Ide.Plugin.Eval.Util (asS, gStrictTry, + handleMaybe, + handleMaybeM, + isLiterate, logWith, + response, response', + timed) import Ide.Types import Language.LSP.Server -import Language.LSP.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length)) -import Language.LSP.Types.Lens (end, line) -import Language.LSP.VFS (virtualFileText) -import System.FilePath (takeFileName) -import System.IO (hClose) -import UnliftIO.Temporary (withSystemTempFile) +import Language.LSP.Types hiding + (SemanticTokenAbsolute (length, line), + SemanticTokenRelative (length)) +import Language.LSP.Types.Lens (end, line) +import Language.LSP.VFS (virtualFileText) +import System.FilePath (takeFileName) +import System.IO (hClose) +import UnliftIO.Temporary (withSystemTempFile) #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Session (unitState, unitDatabases) -import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) +import GHC.Driver.Session (unitDatabases, + unitState) +import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) #else import DynFlags #endif diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index aa148014be..182f5700c3 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -9,8 +9,8 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -77,7 +77,8 @@ import System.IO (IOMode (Wri withFile) import System.IO.Temp #else -import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Core hiding + (setEnv) import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions) import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) import Language.Haskell.GHC.ExactPrint.Types (Rigidity (..)) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 2900c944c1..1b5a88999b 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -12,7 +12,7 @@ import Data.Maybe import Data.Set (Set) import qualified Data.Set as S import Development.IDE.Core.UseStale (Tracked, unTrack) -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (isTopLevel) import Development.IDE.Spans.LocalBindings import Wingman.GHC (algebraicTyCon, normalizeType) import Wingman.Judgements.Theta diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index f540a4a741..65271fd8ee 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -24,7 +24,7 @@ import Data.Ord (Down (..), comparing) import qualified Data.Set as S import Data.Traversable (for) import Development.IDE.Core.Compile (lookupName) -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (isTopLevel) import Refinery.Future import Refinery.ProofState import Refinery.Tactic diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs index 69ed1d9a96..05f5c2b85a 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs @@ -14,7 +14,7 @@ import Data.Monoid import Data.Set (Set) import qualified Data.Set as S import Data.Traversable -import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Core hiding (IsFunction) import Text.Hyphenation (hyphenate, english_US) import Wingman.GHC (tcTyVar_maybe) From c6862f42e46c0dc489833b93a0b7e94da852ec3d Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 7 Sep 2021 13:34:57 +0200 Subject: [PATCH 17/22] Remove one usage of undefined and turn it into a compile-time error --- ghcide/src/Development/IDE/GHC/Compat/Outputable.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 2092caf4f3..e3b6d2a453 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -154,11 +154,7 @@ type PsError = ErrMsg mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault = -#if MIN_VERSION_ghc(9,2,0) - GHC.Types.Name.Ppr.mkPrintUnqualified undefined -#else HscTypes.mkPrintUnqualified unsafeGlobalDynFlags -#endif mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc mkWarnMsg = From e334dc3f793226faabf3742b19ddd6cc6883947c Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 7 Sep 2021 23:18:55 +0200 Subject: [PATCH 18/22] Rebase cleanup --- ghcide/ghcide.cabal | 17 +---------------- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 12 +++--------- haskell-language-server.cabal | 16 ---------------- hls-plugin-api/hls-plugin-api.cabal | 16 ---------------- .../hls-call-hierarchy-plugin.cabal | 16 ---------------- plugins/hls-class-plugin/hls-class-plugin.cabal | 16 ---------------- plugins/hls-eval-plugin/hls-eval-plugin.cabal | 16 ---------------- .../hls-explicit-imports-plugin.cabal | 16 ---------------- .../hls-ormolu-plugin/hls-ormolu-plugin.cabal | 16 ---------------- .../hls-retrie-plugin/hls-retrie-plugin.cabal | 16 ---------------- .../hls-tactics-plugin/src/Wingman/Tactics.hs | 2 ++ stack-9.0.1.yaml | 1 - 12 files changed, 6 insertions(+), 154 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 353791c9dd..66cc4166ab 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -48,6 +48,7 @@ library dependent-map, dependent-sum, dlist, + -- we can't use >= 1.7.10 while we have to use hlint == 3.2.* extra >= 1.7.4 && < 1.7.10, fuzzy, filepath, @@ -109,22 +110,6 @@ library build-depends: unix - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - default-extensions: ApplicativeDo BangPatterns diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index f9b4f1a7df..110c88491d 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1287,14 +1287,8 @@ newImportToEdit (unNewImport -> imp) ps fileContents newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange (L _ HsModule {..}) fileContents | Just (uncurry Position -> insertPos, col) <- case hsmodImports of - [] -> case getLoc (head hsmodDecls) of - RealSrcSpan s _ -> let col = srcLocCol (realSrcSpanStart s) - 1 - in Just ((srcLocLine (realSrcSpanStart s) - 1, col), col) - _ -> Nothing - _ -> case getLoc (last hsmodImports) of - RealSrcSpan s _ -> let col = srcLocCol (realSrcSpanStart s) - 1 - in Just ((srcLocLine $ realSrcSpanEnd s,col), col) - _ -> Nothing + [] -> findPositionNoImports hsmodName hsmodExports fileContents + _ -> findPositionFromImportsOrModuleDecl hsmodImports last True = Just (Range insertPos insertPos, col) | otherwise = Nothing @@ -1308,7 +1302,7 @@ findPositionNoImports (Just hsmodName) _ _ = findPositionFromImportsOrModuleDecl findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int) findPositionFromImportsOrModuleDecl hsField f hasImports = case getLoc (f hsField) of - OldRealSrcSpan s -> + RealSrcSpan s _ -> let col = calcCol s in Just ((srcLocLine (realSrcSpanEnd s), col), col) _ -> Nothing diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 9ed034eb94..8b0f109744 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -360,22 +360,6 @@ executable haskell-language-server , transformers , unordered-containers - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - default-language: Haskell2010 default-extensions: DataKinds, TypeOperators diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index fee9ceed11..feaece622f 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -56,22 +56,6 @@ library , text , unordered-containers - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - if os(windows) build-depends: Win32 diff --git a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal index 85a8cbb59b..d54d0d5677 100644 --- a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal +++ b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal @@ -42,22 +42,6 @@ library default-language: Haskell2010 default-extensions: DataKinds - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - test-suite tests type: exitcode-stdio-1.0 default-language: Haskell2010 diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index 76e0c31a17..766965e1a9 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -36,22 +36,6 @@ library , text , transformers - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - default-language: Haskell2010 default-extensions: DataKinds diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal index c9ba87be6f..16232b61cc 100644 --- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal +++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal @@ -82,22 +82,6 @@ library , unliftio , unordered-containers - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors diff --git a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal index 276c8b567d..f4b8fd0641 100644 --- a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal +++ b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal @@ -28,22 +28,6 @@ library , text , unordered-containers - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - default-language: Haskell2010 default-extensions: DataKinds diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal index 89cd715fab..c1f03546c1 100644 --- a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal +++ b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal @@ -33,22 +33,6 @@ library default-language: Haskell2010 - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - test-suite tests type: exitcode-stdio-1.0 default-language: Haskell2010 diff --git a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal index 277cb904f0..411429f7e2 100644 --- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal +++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal @@ -34,22 +34,6 @@ library , transformers , unordered-containers - if impl(ghc < 8.10.5) - build-depends: - ghc-api-compat ==8.6 - elif impl(ghc == 8.10.5) - build-depends: - ghc-api-compat ==8.10.5 - elif impl(ghc == 8.10.6) - build-depends: - ghc-api-compat ==8.10.6 - elif impl(ghc == 8.10.7) - build-depends: - ghc-api-compat ==8.10.7 - elif impl(ghc == 9.0.1) - build-depends: - ghc-api-compat ==9.0.1 - default-language: Haskell2010 default-extensions: DataKinds diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index fb0545c39d..e2f5d22e04 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -24,6 +24,8 @@ import qualified Data.Map as M import Data.Maybe import Data.Set (Set) import qualified Data.Set as S +import Data.Traversable (for) +import DataCon import Development.IDE.GHC.Compat import GHC.Exts import GHC.SourceGen ((@@)) diff --git a/stack-9.0.1.yaml b/stack-9.0.1.yaml index e00ef00c00..010e96af4a 100644 --- a/stack-9.0.1.yaml +++ b/stack-9.0.1.yaml @@ -37,7 +37,6 @@ extra-deps: - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147 - floskell-0.10.5 -- ghc-api-compat-9.0.1 - ghc-source-gen-0.4.1.0 - heapsize-0.3.0.1@sha256:0b69aa97a46d819b700ac7b145f3b5493c3565cf2c5b8298682238d405d0326e,1417 - hie-bios-0.7.6 From 26b444b57484cec27272faeab1836b00f4cffc17 Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 15 Sep 2021 09:52:24 +0200 Subject: [PATCH 19/22] Add benchmark example file to git Add .gitignore exemption --- ghcide/.gitignore | 4 +++- ghcide/bench/example/HLS | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) create mode 100644 ghcide/bench/example/HLS diff --git a/ghcide/.gitignore b/ghcide/.gitignore index e6abe0e03c..3544e898b0 100644 --- a/ghcide/.gitignore +++ b/ghcide/.gitignore @@ -7,7 +7,9 @@ cabal.project.local /.tasty-rerun-log .vscode /.hlint-* -bench/example/ +bench/example/* +# don't ignore the example file, we need it! +!bench/example/HLS bench-results/ bench-temp/ .shake/ diff --git a/ghcide/bench/example/HLS b/ghcide/bench/example/HLS new file mode 100644 index 0000000000..f95f775b78 --- /dev/null +++ b/ghcide/bench/example/HLS @@ -0,0 +1 @@ +../../.. From 02a7bd1bac9bfe33ed1fbb202cb278e781bc55de Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 15 Sep 2021 10:42:53 +0200 Subject: [PATCH 20/22] Remove a couple of CPP statements from Wingman --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 23 +++++++++++++++++++ .../hls-tactics-plugin/src/Wingman/Debug.hs | 12 ++-------- plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 1 - .../Metaprogramming/Parser/Documentation.hs | 2 +- .../src/Wingman/StaticPlugin.hs | 14 +++++++++-- 5 files changed, 38 insertions(+), 14 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index dcab251aed..cdd5c3ac50 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -272,6 +272,7 @@ module Development.IDE.GHC.Compat.Core ( -- * Role Role(..), -- * Panic + PlainGhcException, panic, -- * Util Module re-exports #if MIN_VERSION_ghc(9,0,0) @@ -293,6 +294,7 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Core.TyCon, module GHC.Core.TyCo.Ppr, module GHC.Core.Type, + module GHC.Core.Unify, module GHC.Core.Utils, module GHC.HsToCore.Docs, @@ -301,6 +303,11 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Iface.Tidy, module GHC.Iface.Syntax, + +#if MIN_VERSION_ghc(9,2,0) + module Language.Haskell.Syntax.Expr, +#endif + module GHC.Rename.Names, module GHC.Rename.Splice, @@ -371,6 +378,7 @@ module Development.IDE.GHC.Compat.Core ( module TysPrim, module TysWiredIn, module Type, + module Unify, module UniqSupply, module Var, #endif @@ -429,6 +437,7 @@ import GHC.Core.TyCo.Ppr import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Core.TyCon import GHC.Core.Type hiding (mkInfForAllTys, mkVisFunTys) +import GHC.Core.Unify import GHC.Core.Utils #if MIN_VERSION_ghc(9,2,0) @@ -525,6 +534,7 @@ import GHC.Unit.Module.ModIface (IfaceExport) import GHC.Unit.State (ModuleOrigin (..)) import GHC.Utils.Error (Severity (..)) import GHC.Utils.Panic hiding (try) +import qualified GHC.Utils.Panic.Plain as Plain #else import qualified Avail import BasicTypes hiding (Version) @@ -583,7 +593,13 @@ import NameCache import NameEnv import NameSet import Packages +#if MIN_VERSION_ghc(8,8,0) import Panic hiding (try) +import qualified PlainPanic as Plain +#else +import Panic hiding (GhcException, try) +import qualified Panic as Plain +#endif import Parser import PatSyn #if MIN_VERSION_ghc(8,8,0) @@ -614,6 +630,7 @@ import TyCon import Type hiding (mkVisFunTys) import TysPrim import TysWiredIn +import Unify import UniqSupply import Var (Var (varName), setTyVarUnique, setVarUnique, varType) @@ -822,3 +839,9 @@ pattern NotBoot, IsBoot :: IsBootInterface pattern NotBoot = False pattern IsBoot = True #endif + +#if MIN_VERSION_ghc(8,8,0) +type PlainGhcException = Plain.PlainGhcException +#else +type PlainGhcException = Plain.GhcException +#endif diff --git a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs index 72b001d3ce..bdbfaacf55 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs @@ -18,17 +18,9 @@ import Control.DeepSeq import Control.Exception import Debug.Trace import Development.IDE.GHC.Compat.Outputable +import Development.IDE.GHC.Compat (PlainGhcException) import System.IO.Unsafe (unsafePerformIO) -#if __GLASGOW_HASKELL__ >= 808 -import PlainPanic (PlainGhcException) -type GHC_EXCEPTION = PlainGhcException -#else -import Panic (GhcException) -type GHC_EXCEPTION = GhcException -#endif - - ------------------------------------------------------------------------------ -- | Print something unsafeRender :: Outputable a => a -> String @@ -40,7 +32,7 @@ unsafeRender' sdoc = unsafePerformIO $ do let z = showSDocUnsafe sdoc -- We might not have unsafeGlobalDynFlags (like during testing), in which -- case GHC panics. Instead of crashing, let's just fail to print. - !res <- try @GHC_EXCEPTION $ evaluate $ deepseq z z + !res <- try @PlainGhcException $ evaluate $ deepseq z z pure $ either (const "") id res {-# NOINLINE unsafeRender' #-} diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index 6897c33768..647d6cd60b 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -18,7 +18,6 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import GHC.SourceGen (lambda) import Generics.SYB (Data, everything, everywhere, listify, mkQ, mkT) -import Unify import Wingman.StaticPlugin (pattern MetaprogramSyntax) import Wingman.Types diff --git a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs index b63dea6f08..7b047513f8 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Metaprogramming/Parser/Documentation.hs @@ -8,7 +8,7 @@ import Data.String (IsString) import Data.Text (Text) import Data.Text.Prettyprint.Doc hiding (parens) import Data.Text.Prettyprint.Doc.Render.String (renderString) -import GhcPlugins (OccName) +import Development.IDE.GHC.Compat (OccName) import qualified Text.Megaparsec as P import Wingman.Metaprogramming.Lexer (Parser, identifier, variable, parens) import Wingman.Types (TacticsM) diff --git a/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs b/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs index 97ffe53e54..441c0ae329 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/StaticPlugin.hs @@ -40,9 +40,15 @@ pattern MetaprogramSourceText = SourceText "wingman-meta-program" pattern WingmanMetaprogram :: FastString -> HsExpr p -pattern WingmanMetaprogram mp - <- HsSCC _ MetaprogramSourceText (StringLiteral NoSourceText mp) +pattern WingmanMetaprogram mp <- +#if __GLASGOW_HASKELL__ >= 900 + HsPragE _ (HsPragSCC _ MetaprogramSourceText (StringLiteral NoSourceText mp)) (L _ ( HsVar _ _)) +#else + HsSCC _ MetaprogramSourceText (StringLiteral NoSourceText mp) + (L _ ( HsVar _ _)) +#endif + enableQuasiQuotes :: DynFlags -> DynFlags @@ -72,7 +78,11 @@ metaprogramHoleName = mkVarOcc "_$metaprogram" mkMetaprogram :: SrcSpan -> FastString -> HsExpr GhcPs mkMetaprogram ss mp = +#if __GLASGOW_HASKELL__ >= 900 + HsPragE noExtField (HsPragSCC noExtField MetaprogramSourceText (StringLiteral NoSourceText mp)) +#else HsSCC noExtField MetaprogramSourceText (StringLiteral NoSourceText mp) +#endif $ L ss $ HsVar noExtField $ L ss From 8bb403b996883bd53ff83e45a0e1bfd7c67f579e Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 15 Sep 2021 11:06:14 +0200 Subject: [PATCH 21/22] Address hlint warnings --- ghcide/.hlint.yaml | 1 + ghcide/src/Development/IDE/GHC/Compat.hs | 1 - ghcide/src/Development/IDE/GHC/Compat/Core.hs | 5 +++-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/ghcide/.hlint.yaml b/ghcide/.hlint.yaml index 3bdc5d0242..725604f7df 100644 --- a/ghcide/.hlint.yaml +++ b/ghcide/.hlint.yaml @@ -123,6 +123,7 @@ - default: false - {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]} - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.IDE.GHC.Compat.Core, Development.Benchmark.Rules]} + - {name: [-Wno-unused-imports], within: [Development.IDE.GHC.Compat.Core]} - {name: [-Wno-deprecations, -Wno-unticked-promoted-constructors], within: [Main, Experiments]} # - modules: # - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 948a854f80..97f0b1eb23 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -4,7 +4,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE PatternSynonyms #-} {-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-} -- | Attempt at hiding the GHC version differences we can. diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index cdd5c3ac50..b2f560e9c3 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -611,7 +611,6 @@ import PrelNames hiding (Unique, printName) import RdrName import RnNames import RnSplice -import SrcLoc (SrcSpan (UnhelpfulSpan)) import qualified SrcLoc import TcEnv import TcEvidence hiding ((<.>)) @@ -638,8 +637,10 @@ import Var (Var (varName), setTyVarUnique, #if MIN_VERSION_ghc(8,10,0) import Coercion (coercionKind) import Predicate +import SrcLoc (SrcSpan (UnhelpfulSpan)) #else -import SrcLoc (RealLocated) +import SrcLoc (RealLocated, + SrcSpan (UnhelpfulSpan)) #endif #endif From 8c8b8c5ce04f886eb94ae133aa23a17f59ee8768 Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 15 Sep 2021 11:59:50 +0200 Subject: [PATCH 22/22] Re-export Compat.Outputable module from top-level Compat module --- ghcide/src/Development/IDE/Core/Compile.hs | 61 +++--- .../src/Development/IDE/Core/Preprocessor.hs | 21 +- ghcide/src/Development/IDE/GHC/Compat.hs | 2 + ghcide/src/Development/IDE/GHC/Error.hs | 10 +- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 1 - ghcide/src/Development/IDE/GHC/Util.hs | 69 ++++--- ghcide/src/Development/IDE/GHC/Warnings.hs | 3 +- .../src/Development/IDE/Import/FindImports.hs | 5 +- ghcide/src/Development/IDE/LSP/Outline.hs | 1 - .../src/Development/IDE/Plugin/CodeAction.hs | 1 - .../IDE/Plugin/CodeAction/ExactPrint.hs | 3 +- .../src/Development/IDE/Plugin/Completions.hs | 1 - .../IDE/Plugin/Completions/Logic.hs | 9 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 105 +++++----- ghcide/src/Development/IDE/Spans/AtPoint.hs | 3 +- ghcide/src/Development/IDE/Spans/Common.hs | 1 - .../src/Ide/Plugin/Eval/CodeLens.hs | 189 +++++++++--------- .../src/Ide/Plugin/Eval/GHC.hs | 11 +- .../src/Ide/Plugin/Eval/Util.hs | 44 ++-- .../src/Ide/Plugin/Retrie.hs | 18 +- .../src/Ide/Plugin/Splice.hs | 1 - .../hls-tactics-plugin/src/Wingman/Debug.hs | 3 +- .../src/Wingman/EmptyCase.hs | 2 +- .../src/Wingman/Judgements/Theta.hs | 2 +- .../src/Wingman/LanguageServer.hs | 2 +- .../src/Wingman/LanguageServer/Metaprogram.hs | 2 +- .../src/Wingman/Machinery.hs | 2 +- .../hls-tactics-plugin/src/Wingman/Tactics.hs | 3 +- 28 files changed, 277 insertions(+), 298 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 9f69150d53..ce889fb7ba 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -36,7 +36,7 @@ import Development.IDE.Core.Preprocessor import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake import Development.IDE.GHC.Error -import Development.IDE.GHC.Orphans () +import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util import Development.IDE.GHC.Warnings import Development.IDE.Spans.Common @@ -44,23 +44,21 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options -import Development.IDE.GHC.Compat hiding (loadInterface, - parseHeader, - parseModule, tcRnModule, - writeHieFile) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat as GHC -import Development.IDE.GHC.Compat.Outputable -import qualified Development.IDE.GHC.Compat.Util as Util +import Development.IDE.GHC.Compat hiding (loadInterface, + parseHeader, parseModule, + tcRnModule, writeHieFile) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as GHC +import qualified Development.IDE.GHC.Compat.Util as Util import HieDb -import Language.LSP.Types (DiagnosticTag (..)) +import Language.LSP.Types (DiagnosticTag (..)) #if MIN_VERSION_ghc(8,10,0) -import Control.DeepSeq (force, rnf) +import Control.DeepSeq (force, rnf) #else -import Control.DeepSeq (rnf) +import Control.DeepSeq (rnf) import ErrUtils #endif @@ -71,42 +69,41 @@ import GHC.Tc.Gen.Splice import TcSplice #endif -import Control.Exception (evaluate) +import Control.Exception (evaluate) import Control.Exception.Safe -import Control.Lens hiding (List) +import Control.Lens hiding (List) import Control.Monad.Except import Control.Monad.Extra import Control.Monad.Trans.Except -import Data.Bifunctor (first, second) -import qualified Data.ByteString as BS -import qualified Data.DList as DL +import Data.Bifunctor (first, second) +import qualified Data.ByteString as BS +import qualified Data.DList as DL import Data.IORef import Data.List.Extra -import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict as Map import Data.Maybe -import qualified Data.Text as T -import Data.Time (UTCTime, getCurrentTime) -import qualified GHC.LanguageExtensions as LangExt +import qualified Data.Text as T +import Data.Time (UTCTime, getCurrentTime) +import qualified GHC.LanguageExtensions as LangExt import System.Directory import System.FilePath -import System.IO.Extra (fixIO, - newTempFileWithin) +import System.IO.Extra (fixIO, newTempFileWithin) -- GHC API imports -import GHC (GetDocsFailure (..), - parsedSource) +import GHC (GetDocsFailure (..), + parsedSource) import Control.Concurrent.Extra -import Control.Concurrent.STM hiding (orElse) -import Data.Aeson (toJSON) +import Control.Concurrent.STM hiding (orElse) +import Data.Aeson (toJSON) import Data.Binary import Data.Coerce import Data.Functor -import qualified Data.HashMap.Strict as HashMap -import Data.Tuple.Extra (dupe) -import Data.Unique as Unique -import qualified Language.LSP.Server as LSP -import qualified Language.LSP.Types as LSP +import qualified Data.HashMap.Strict as HashMap +import Data.Tuple.Extra (dupe) +import Data.Unique as Unique +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'. parseModule diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index bb958065db..29fe43296e 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -7,26 +7,25 @@ module Development.IDE.Core.Preprocessor import Development.IDE.GHC.CPP import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Outputable -import qualified Development.IDE.GHC.Compat.Util as Util -import Development.IDE.GHC.Orphans () +import qualified Development.IDE.GHC.Compat.Util as Util +import Development.IDE.GHC.Orphans () -import Control.DeepSeq (NFData (rnf)) -import Control.Exception (evaluate) -import Control.Exception.Safe (catch, throw) +import Control.DeepSeq (NFData (rnf)) +import Control.Exception (evaluate) +import Control.Exception.Safe (catch, throw) import Control.Monad.IO.Class import Control.Monad.Trans.Except import Data.Char -import Data.IORef (IORef, modifyIORef, - newIORef, readIORef) +import Data.IORef (IORef, modifyIORef, + newIORef, readIORef) import Data.List.Extra import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as T import Development.IDE.GHC.Error import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location -import qualified GHC.LanguageExtensions as LangExt +import qualified GHC.LanguageExtensions as LangExt import System.FilePath import System.IO.Extra diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 97f0b1eb23..79840ba37f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -45,6 +45,7 @@ module Development.IDE.GHC.Compat( module Development.IDE.GHC.Compat.Env, module Development.IDE.GHC.Compat.Iface, module Development.IDE.GHC.Compat.Logger, + module Development.IDE.GHC.Compat.Outputable, module Development.IDE.GHC.Compat.Parser, module Development.IDE.GHC.Compat.Plugins, module Development.IDE.GHC.Compat.Units, @@ -61,6 +62,7 @@ import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface import Development.IDE.GHC.Compat.Logger +import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Compat.Parser import Development.IDE.GHC.Compat.Plugins import Development.IDE.GHC.Compat.Units diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index 5a17c6643d..6abb3917a4 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -32,10 +32,12 @@ module Development.IDE.GHC.Error import Data.Maybe import Data.String (fromString) import qualified Data.Text as T -import qualified Development.IDE.GHC.Compat.Outputable as Compat +import Development.IDE.GHC.Compat (DecoratedSDoc, MsgEnvelope, + errMsgSeverity, errMsgSpan, + formatErrorWithQual, + srcErrorMessages) import qualified Development.IDE.GHC.Compat as Compat import qualified Development.IDE.GHC.Compat.Util as Compat -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics as D import Development.IDE.Types.Location @@ -66,7 +68,7 @@ diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) -- | Convert a GHC SrcSpan to a DAML compiler Range srcSpanToRange :: SrcSpan -> Maybe Range -srcSpanToRange (UnhelpfulSpan _) = Nothing +srcSpanToRange (UnhelpfulSpan _) = Nothing srcSpanToRange (Compat.RealSrcSpan real _) = Just $ realSrcSpanToRange real -- srcSpanToRange = fmap realSrcSpanToRange . realSpan @@ -152,7 +154,7 @@ realSpan :: SrcSpan -> Maybe RealSrcSpan realSpan = \case Compat.RealSrcSpan r _ -> Just r - UnhelpfulSpan _ -> Nothing + UnhelpfulSpan _ -> Nothing -- | Catch the errors thrown by GHC (SourceErrors and diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 96496e0967..8ce27a9f3b 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -57,7 +57,6 @@ import Development.IDE.Core.Shake import Development.IDE.GHC.Compat hiding (parseImport, parsePattern, parseType) -import Development.IDE.GHC.Compat.Outputable import Development.IDE.Graph (RuleResult, Rules) import Development.IDE.Graph.Classes import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 33fd105b10..1e3568086b 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -33,71 +33,70 @@ module Development.IDE.GHC.Util( #if MIN_VERSION_ghc(9,2,0) import GHC import GHC.Core.Multiplicity -import qualified GHC.Core.TyCo.Rep as TyCoRep +import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Data.FastString import GHC.Data.StringBuffer import GHC.Driver.Env import GHC.Driver.Env.Types import GHC.Driver.Monad -import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags import GHC.Hs.Extension -import qualified GHC.Hs.Type as GHC -import GHC.Iface.Env (updNameCache) -import GHC.Iface.Make (mkIfaceExports) -import qualified GHC.Linker.Types as LinkerTypes +import qualified GHC.Hs.Type as GHC +import GHC.Iface.Env (updNameCache) +import GHC.Iface.Make (mkIfaceExports) +import qualified GHC.Linker.Types as LinkerTypes import GHC.Parser.Lexer import GHC.Runtime.Context -import GHC.Tc.Types (TcGblEnv (tcg_exports)) -import GHC.Tc.Utils.TcType (pprSigmaType) +import GHC.Tc.Types (TcGblEnv (tcg_exports)) +import GHC.Tc.Utils.TcType (pprSigmaType) import GHC.Types.Avail import GHC.Types.Name.Cache import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader import GHC.Types.SrcLoc -import qualified GHC.Types.SrcLoc as SrcLoc +import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Unit.Env -import GHC.Unit.Info (PackageName) -import qualified GHC.Unit.Info as Packages -import qualified GHC.Unit.Module.Location as Module +import GHC.Unit.Info (PackageName) +import qualified GHC.Unit.Info as Packages +import qualified GHC.Unit.Module.Location as Module import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (mi_mod_hash) -import GHC.Unit.Module.Name (moduleNameSlashes) -import qualified GHC.Unit.State as Packages -import GHC.Unit.Types (IsBootInterface (..), - unitString) -import qualified GHC.Unit.Types as Module +import GHC.Unit.Module.ModIface (mi_mod_hash) +import GHC.Unit.Module.Name (moduleNameSlashes) +import qualified GHC.Unit.State as Packages +import GHC.Unit.Types (IsBootInterface (..), + unitString) +import qualified GHC.Unit.Types as Module import GHC.Utils.Fingerprint import GHC.Utils.Outputable -import qualified GHC.Utils.Outputable as Outputable +import qualified GHC.Utils.Outputable as Outputable #endif import Control.Concurrent -import Control.Exception as E -import Data.Binary.Put (Put, runPut) -import qualified Data.ByteString as BS -import Data.ByteString.Internal (ByteString (..)) -import qualified Data.ByteString.Internal as BS -import qualified Data.ByteString.Lazy as LBS +import Control.Exception as E +import Data.Binary.Put (Put, runPut) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (ByteString (..)) +import qualified Data.ByteString.Internal as BS +import qualified Data.ByteString.Lazy as LBS import Data.IORef import Data.List.Extra import Data.Maybe -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Encoding.Error as T +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Encoding.Error as T import Data.Typeable -import Development.IDE.GHC.Compat as GHC -import Development.IDE.GHC.Compat.Outputable -import qualified Development.IDE.GHC.Compat.Parser as Compat -import qualified Development.IDE.GHC.Compat.Units as Compat +import Development.IDE.GHC.Compat as GHC +import qualified Development.IDE.GHC.Compat.Parser as Compat +import qualified Development.IDE.GHC.Compat.Units as Compat import Development.IDE.GHC.Compat.Util import Development.IDE.Types.Location import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import GHC -import GHC.IO.BufferedIO (BufferedIO) -import GHC.IO.Device as IODevice +import GHC.IO.BufferedIO (BufferedIO) +import GHC.IO.Device as IODevice import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs index a10d9dad12..720828fef3 100644 --- a/ghcide/src/Development/IDE/GHC/Warnings.hs +++ b/ghcide/src/Development/IDE/GHC/Warnings.hs @@ -4,12 +4,11 @@ module Development.IDE.GHC.Warnings(withWarnings) where -import Data.List import Control.Concurrent.Strict +import Data.List import qualified Data.Text as T import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error import Development.IDE.Types.Diagnostics import Language.LSP.Types (type (|?) (..)) diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 476e6969b1..101e21fe32 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -13,14 +13,13 @@ module Development.IDE.Import.FindImports , mkImportDirs ) where +import Control.DeepSeq import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error as ErrUtils import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location -import Control.DeepSeq -- standard imports import Control.Monad.Extra @@ -127,7 +126,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do lookupLocal dirs = do mbFile <- locateModuleFile dirs exts targetFor isSource $ unLoc modName case mbFile of - Nothing -> return $ Left $ notFoundErr env modName $ LookupNotFound [] + Nothing -> return $ Left $ notFoundErr env modName $ LookupNotFound [] Just file -> toModLocation file lookupInPackageDB env = diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 7b07195c54..82bdc573cd 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -18,7 +18,6 @@ import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Error (rangeToRealSrcSpan, realSrcSpanToRange) import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 110c88491d..edabeab3dd 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -42,7 +42,6 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules import Development.IDE.Core.Service import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util (prettyPrint, diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index ec09090d79..b79775c8c4 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -30,8 +30,7 @@ import Data.Maybe (fromJust, isNothing, mapMaybe) import qualified Data.Text as T import Development.IDE.GHC.Compat -import qualified Development.IDE.GHC.Compat.Util as Util -import Development.IDE.GHC.Compat.Outputable +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), Annotate) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index b5e1449619..7a52d0a0ba 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -30,7 +30,6 @@ import Development.IDE.GHC.ExactPrint (Annotated (annsA) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph import Development.IDE.Graph.Classes -import Development.IDE.Import.FindImports import Development.IDE.Plugin.CodeAction (newImport, newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 68d27bf244..fbf66ab366 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -31,12 +31,11 @@ import Data.Aeson (ToJSON (toJSON)) import Data.Either (fromRight) import Data.Functor import qualified Data.HashMap.Strict as HM -import qualified Data.Set as Set import qualified Data.HashSet as HashSet +import qualified Data.Set as Set import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat as GHC -import Development.IDE.GHC.Compat.Outputable hiding (ppr) +import Development.IDE.GHC.Compat as GHC hiding (ppr) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util @@ -599,8 +598,8 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu | otherwise = [] if - -- TODO: handle multiline imports - | "import " `T.isPrefixOf` fullLine + -- TODO: handle multiline imports + | "import " `T.isPrefixOf` fullLine && (List.length (words (T.unpack fullLine)) >= 2) && "(" `isInfixOf` T.unpack fullLine -> do diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index ce9c0d8317..6ce6001fa3 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -12,63 +12,60 @@ module Development.IDE.Plugin.TypeLenses ( GlobalBindingTypeSigsResult (..), ) where -import Control.DeepSeq (rwhnf) -import Control.Monad (mzero) -import Control.Monad.Extra (whenMaybe) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Data.Aeson.Types (Value (..), toJSON) -import qualified Data.Aeson.Types as A -import qualified Data.HashMap.Strict as Map -import Data.List (find) -import Data.Maybe (catMaybes) -import qualified Data.Text as T -import Development.IDE (GhcSession (..), - HscEnvEq (hscEnv), - RuleResult, Rules, - define, srcSpanToRange) -import Development.IDE.Core.Compile (TcModuleResult (..)) -import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), - TypeCheck (TypeCheck)) -import Development.IDE.Core.Rules (IdeState, runAction) -import Development.IDE.Core.Service (getDiagnostics) -import Development.IDE.Core.Shake (getHiddenDiagnostics, - use) +import Control.DeepSeq (rwhnf) +import Control.Monad (mzero) +import Control.Monad.Extra (whenMaybe) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Aeson.Types (Value (..), toJSON) +import qualified Data.Aeson.Types as A +import qualified Data.HashMap.Strict as Map +import Data.List (find) +import Data.Maybe (catMaybes) +import qualified Data.Text as T +import Development.IDE (GhcSession (..), + HscEnvEq (hscEnv), + RuleResult, Rules, define, + srcSpanToRange) +import Development.IDE.Core.Compile (TcModuleResult (..)) +import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), + TypeCheck (TypeCheck)) +import Development.IDE.Core.Rules (IdeState, runAction) +import Development.IDE.Core.Service (getDiagnostics) +import Development.IDE.Core.Shake (getHiddenDiagnostics, use) import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Outputable -import Development.IDE.GHC.Util (printName) +import Development.IDE.GHC.Util (printName) import Development.IDE.Graph.Classes -import Development.IDE.Spans.LocalBindings (Bindings, getFuzzyScope) -import Development.IDE.Types.Location (Position (Position, _character, _line), - Range (Range, _end, _start), - toNormalizedFilePath', - uriToFilePath') -import GHC.Generics (Generic) -import Ide.Plugin.Config (Config) +import Development.IDE.Spans.LocalBindings (Bindings, getFuzzyScope) +import Development.IDE.Types.Location (Position (Position, _character, _line), + Range (Range, _end, _start), + toNormalizedFilePath', + uriToFilePath') +import GHC.Generics (Generic) +import Ide.Plugin.Config (Config) import Ide.Plugin.Properties -import Ide.PluginUtils (mkLspCommand, - usePropertyLsp) -import Ide.Types (CommandFunction, - CommandId (CommandId), - PluginCommand (PluginCommand), - PluginDescriptor (..), - PluginId, - configCustomConfig, - defaultConfigDescriptor, - defaultPluginDescriptor, - mkCustomConfig, - mkPluginHandler) -import qualified Language.LSP.Server as LSP -import Language.LSP.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), - CodeLens (CodeLens), - CodeLensParams (CodeLensParams, _textDocument), - Diagnostic (..), - List (..), - ResponseError, - SMethod (..), - TextDocumentIdentifier (TextDocumentIdentifier), - TextEdit (TextEdit), - WorkspaceEdit (WorkspaceEdit)) -import Text.Regex.TDFA ((=~), (=~~)) +import Ide.PluginUtils (mkLspCommand, + usePropertyLsp) +import Ide.Types (CommandFunction, + CommandId (CommandId), + PluginCommand (PluginCommand), + PluginDescriptor (..), + PluginId, + configCustomConfig, + defaultConfigDescriptor, + defaultPluginDescriptor, + mkCustomConfig, + mkPluginHandler) +import qualified Language.LSP.Server as LSP +import Language.LSP.Types (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams), + CodeLens (CodeLens), + CodeLensParams (CodeLensParams, _textDocument), + Diagnostic (..), + List (..), ResponseError, + SMethod (..), + TextDocumentIdentifier (TextDocumentIdentifier), + TextEdit (TextEdit), + WorkspaceEdit (WorkspaceEdit)) +import Text.Regex.TDFA ((=~), (=~~)) typeLensCommandId :: T.Text typeLensCommandId = "typesignature.add" diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 19a391c56d..36bdd58303 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -30,8 +30,7 @@ import Language.LSP.Types import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Outputable -import qualified Development.IDE.GHC.Compat.Util as Util +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.Spans.Common import Development.IDE.Types.Options diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index d7b4535a7a..0a60120138 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -25,7 +25,6 @@ import GHC.Generics import GHC -import Development.IDE.GHC.Compat.Outputable import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () import Development.IDE.GHC.Util diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 6ef585d8f1..10b82027a5 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -25,109 +25,104 @@ module Ide.Plugin.Eval.CodeLens ( evalCommand, ) where -import Control.Applicative (Alternative ((<|>))) -import Control.Arrow (second, (>>>)) -import Control.Exception (try) -import qualified Control.Exception as E -import Control.Lens (_1, _3, (%~), (<&>), - (^.)) -import Control.Monad (guard, join, void, when) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Except (ExceptT (..)) -import Data.Aeson (toJSON) -import Data.Char (isSpace) -import qualified Data.DList as DL -import qualified Data.HashMap.Strict as HashMap -import Data.List (dropWhileEnd, find, - intercalate, - intersperse) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe) -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (getCurrentTime) -import Data.Typeable (Typeable) -import Development.IDE (Action, - GetDependencies (..), - GetModIface (..), - GetModSummary (..), - GetParsedModuleWithComments (..), - GhcSessionIO (..), - HiFileResult (hirHomeMod, hirModSummary), - HscEnvEq, IdeState, - ModSummaryResult (..), - evalGhcEnv, - hscEnvWithImportPaths, - prettyPrint, - realSrcSpanToRange, - runAction, - textToStringBuffer, - toNormalizedFilePath', - uriToFilePath', - useNoFile_, - useWithStale_, use_, - uses_) -import Development.IDE.Core.Compile (loadModulesHome, - setupFinderCache) -import Development.IDE.Core.PositionMapping (toCurrentRange) -import Development.IDE.Core.Rules (TransitiveDependencies (transitiveModuleDeps)) -import Development.IDE.GHC.Compat hiding (typeKind, - unitState) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat as SrcLoc -import Development.IDE.GHC.Compat.Outputable -import Development.IDE.GHC.Compat.Util (GhcException, - OverridingBool (..)) -import qualified Development.IDE.GHC.Compat.Util as FastString +import Control.Applicative (Alternative ((<|>))) +import Control.Arrow (second, (>>>)) +import Control.Exception (try) +import qualified Control.Exception as E +import Control.Lens (_1, _3, (%~), (<&>), + (^.)) +import Control.Monad (guard, join, void, when) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Except (ExceptT (..)) +import Data.Aeson (toJSON) +import Data.Char (isSpace) +import qualified Data.DList as DL +import qualified Data.HashMap.Strict as HashMap +import Data.List (dropWhileEnd, find, + intercalate, intersperse) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, fromMaybe) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (getCurrentTime) +import Data.Typeable (Typeable) +import Development.IDE (Action, + GetDependencies (..), + GetModIface (..), + GetModSummary (..), + GetParsedModuleWithComments (..), + GhcSessionIO (..), + HiFileResult (hirHomeMod, hirModSummary), + HscEnvEq, IdeState, + ModSummaryResult (..), + evalGhcEnv, + hscEnvWithImportPaths, + prettyPrint, + realSrcSpanToRange, + runAction, + textToStringBuffer, + toNormalizedFilePath', + uriToFilePath', + useNoFile_, + useWithStale_, use_, + uses_) +import Development.IDE.Core.Compile (loadModulesHome, + setupFinderCache) +import Development.IDE.Core.PositionMapping (toCurrentRange) +import Development.IDE.Core.Rules (TransitiveDependencies (transitiveModuleDeps)) +import Development.IDE.GHC.Compat hiding (typeKind, + unitState) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as SrcLoc +import Development.IDE.GHC.Compat.Util (GhcException, + OverridingBool (..)) +import qualified Development.IDE.GHC.Compat.Util as FastString import Development.IDE.Types.Options -import GHC (ClsInst, - ExecOptions (execLineNumber, execSourceFile), - FamInst, GhcMonad, - LoadHowMuch (LoadAllTargets), - NamedThing (getName), - defaultFixity, - execOptions, exprType, - getInfo, - getInteractiveDynFlags, - isImport, isStmt, load, - parseName, pprFamInst, - pprInstance, - setLogAction, - setTargets, typeKind) -import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) - -import Ide.Plugin.Eval.Code (Statement, asStatements, - evalSetup, myExecStmt, - propSetup, resultRange, - testCheck, testRanges) -import Ide.Plugin.Eval.GHC (addImport, addPackages, - hasPackage, - showDynFlags) -import Ide.Plugin.Eval.Parse.Comments (commentsToSections) -import Ide.Plugin.Eval.Parse.Option (parseSetFlags) +import GHC (ClsInst, + ExecOptions (execLineNumber, execSourceFile), + FamInst, GhcMonad, + LoadHowMuch (LoadAllTargets), + NamedThing (getName), + defaultFixity, + execOptions, exprType, + getInfo, + getInteractiveDynFlags, + isImport, isStmt, load, + parseName, pprFamInst, + pprInstance, + setLogAction, setTargets, + typeKind) +import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) + +import Ide.Plugin.Eval.Code (Statement, asStatements, + evalSetup, myExecStmt, + propSetup, resultRange, + testCheck, testRanges) +import Ide.Plugin.Eval.GHC (addImport, addPackages, + hasPackage, showDynFlags) +import Ide.Plugin.Eval.Parse.Comments (commentsToSections) +import Ide.Plugin.Eval.Parse.Option (parseSetFlags) import Ide.Plugin.Eval.Types -import Ide.Plugin.Eval.Util (asS, gStrictTry, - handleMaybe, - handleMaybeM, - isLiterate, logWith, - response, response', - timed) +import Ide.Plugin.Eval.Util (asS, gStrictTry, + handleMaybe, + handleMaybeM, isLiterate, + logWith, response, + response', timed) import Ide.Types import Language.LSP.Server -import Language.LSP.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length)) -import Language.LSP.Types.Lens (end, line) -import Language.LSP.VFS (virtualFileText) -import System.FilePath (takeFileName) -import System.IO (hClose) -import UnliftIO.Temporary (withSystemTempFile) +import Language.LSP.Types hiding + (SemanticTokenAbsolute (length, line), + SemanticTokenRelative (length)) +import Language.LSP.Types.Lens (end, line) +import Language.LSP.VFS (virtualFileText) +import System.FilePath (takeFileName) +import System.IO (hClose) +import UnliftIO.Temporary (withSystemTempFile) #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Session (unitDatabases, - unitState) -import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) +import GHC.Driver.Session (unitDatabases, unitState) +import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) #else import DynFlags #endif diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs index b23888e587..e5232759ce 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs @@ -13,16 +13,15 @@ module Ide.Plugin.Eval.GHC ( showDynFlags, ) where -import Data.List (isPrefixOf) -import Data.Maybe (mapMaybe) -import Data.String (fromString) +import Data.List (isPrefixOf) +import Data.Maybe (mapMaybe) +import Data.String (fromString) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util -import Development.IDE.GHC.Compat.Outputable import qualified Development.IDE.GHC.Compat.Util as EnumSet -import GHC.LanguageExtensions.Type (Extension (..)) -import Ide.Plugin.Eval.Util (asS, gStrictTry) +import GHC.LanguageExtensions.Type (Extension (..)) +import Ide.Plugin.Eval.Util (asS, gStrictTry) {- $setup >>> import GHC diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index 675fa12a9e..a249aa1214 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -15,30 +15,30 @@ module Ide.Plugin.Eval.Util ( logWith, ) where -import Control.Exception (SomeException, evaluate) -import Control.Monad.Extra (maybeM) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE) -import Data.Aeson (Value (Null)) -import Data.Bifunctor (first) -import Data.String (IsString (fromString)) -import qualified Data.Text as T -import Development.IDE (IdeState, Priority (..), ideLogger, - logPriority) -import Development.IDE.GHC.Compat.Outputable - (Outputable, showSDocUnsafe, ppr) -import Development.IDE.GHC.Compat.Util - (MonadCatch, catch) -import GHC.Exts (toList) -import GHC.Stack (HasCallStack, callStack, - srcLocFile, srcLocStartCol, - srcLocStartLine) +import Control.Exception (SomeException, evaluate) +import Control.Monad.Extra (maybeM) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT, + throwE) +import Data.Aeson (Value (Null)) +import Data.Bifunctor (first) +import Data.String (IsString (fromString)) +import qualified Data.Text as T +import Development.IDE (IdeState, Priority (..), + ideLogger, logPriority) +import Development.IDE.GHC.Compat (Outputable, ppr, + showSDocUnsafe) +import Development.IDE.GHC.Compat.Util (MonadCatch, catch) +import GHC.Exts (toList) +import GHC.Stack (HasCallStack, callStack, + srcLocFile, srcLocStartCol, + srcLocStartLine) import Language.LSP.Server import Language.LSP.Types -import System.FilePath (takeExtension) -import System.Time.Extra (duration, showDuration) -import UnliftIO.Exception (catchAny) +import System.FilePath (takeExtension) +import System.Time.Extra (duration, showDuration) +import UnliftIO.Exception (catchAny) asS :: Outputable a => a -> String asS = showSDocUnsafe . ppr diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index eeb70b21d0..5771964067 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -57,26 +57,28 @@ import Development.IDE.GHC.Compat (GenLocated (L), GhcRn, HscEnv, IdP, LRuleDecls, ModSummary (ModSummary, ms_hspp_buf, ms_mod), NHsValBindsLR (..), + Outputable, ParsedModule (..), RuleDecl (HsRule), RuleDecls (HsRules), + SourceText (..), SrcSpan (..), TyClDecl (SynDecl), TyClGroup (..), fun_id, + hm_iface, isQual, + isQual_maybe, mi_fixities, moduleNameString, + nameModule_maybe, + nameRdrName, occNameFS, + occNameString, parseModule, pattern IsBoot, pattern NotBoot, pattern RealSrcSpan, - rds_rules, srcSpanFile, - nameRdrName, occNameString, - rdrNameOcc, occNameFS, - nameModule_maybe, - isQual, isQual_maybe, - hm_iface, SourceText(..)) -import Development.IDE.GHC.Compat.Util hiding (try, catch) -import Development.IDE.GHC.Compat.Outputable(Outputable) + rdrNameOcc, rds_rules, + srcSpanFile) +import Development.IDE.GHC.Compat.Util hiding (catch, try) import qualified GHC (parseModule) import GHC.Generics (Generic) import Ide.PluginUtils diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 45c6688d2b..4e51e59b69 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -45,7 +45,6 @@ import Data.Maybe (fromMaybe, listToMaybe, import qualified Data.Text as T import Development.IDE import Development.IDE.GHC.Compat as Compat hiding (getLoc) -import Development.IDE.GHC.Compat.Outputable import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint import GHC.Exts diff --git a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs index bdbfaacf55..1c5e0f5517 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs @@ -17,8 +17,7 @@ module Wingman.Debug import Control.DeepSeq import Control.Exception import Debug.Trace -import Development.IDE.GHC.Compat.Outputable -import Development.IDE.GHC.Compat (PlainGhcException) +import Development.IDE.GHC.Compat (PlainGhcException, Outputable(..), SDoc, showSDocUnsafe) import System.IO.Unsafe (unsafePerformIO) ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs index 8d2bd69725..42c62cfc19 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs @@ -22,7 +22,7 @@ import Development.IDE (realSrcSpanToRange) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake (IdeState (..)) import Development.IDE.Core.UseStale -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (empty) import Development.IDE.GHC.ExactPrint import Development.IDE.Spans.LocalBindings (getLocalScope) import Ide.Types diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs index 641765015f..c2fccd4d7d 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements/Theta.hs @@ -20,7 +20,7 @@ import Data.Generics.Sum (_Ctor) import Data.Set (Set) import qualified Data.Set as S import Development.IDE.Core.UseStale -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (empty) import Generics.SYB hiding (tyConName, empty, Generic) import GHC.Generics import Wingman.GHC diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index e96fb61236..3524194fb1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -34,7 +34,7 @@ import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (IdeState (..), uses, define, use) import qualified Development.IDE.Core.Shake as IDE import Development.IDE.Core.UseStale -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (empty) import qualified Development.IDE.GHC.Compat.Util as FastString import Development.IDE.GHC.Error (realSrcSpanToRange) import Development.IDE.GHC.ExactPrint diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs index 3fd853bc31..1cdee0b02d 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/Metaprogram.hs @@ -21,7 +21,7 @@ import Development.IDE (realSrcSpanToRange) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake (IdeState (..)) import Development.IDE.Core.UseStale -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (empty) import Ide.Types import Language.LSP.Types import Prelude hiding (span) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index 65271fd8ee..56fd9f7b2e 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -24,7 +24,7 @@ import Data.Ord (Down (..), comparing) import qualified Data.Set as S import Data.Traversable (for) import Development.IDE.Core.Compile (lookupName) -import Development.IDE.GHC.Compat hiding (isTopLevel) +import Development.IDE.GHC.Compat hiding (isTopLevel, empty) import Refinery.Future import Refinery.ProofState import Refinery.Tactic diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index e2f5d22e04..d6909a11ca 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -17,7 +17,6 @@ import Data.Bool (bool) import Data.Foldable import Data.Functor ((<&>)) import Data.Generics.Labels () -import Data.Traversable (for) import Data.List import Data.List.Extra (dropEnd, takeEnd) import qualified Data.Map as M @@ -26,7 +25,7 @@ import Data.Set (Set) import qualified Data.Set as S import Data.Traversable (for) import DataCon -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (empty) import GHC.Exts import GHC.SourceGen ((@@)) import GHC.SourceGen.Expr