9.4 support + MHU

Author: wz1000

cabal-941.project

@@ -0,0 +1,92 @@
+packages:
+         ./hie-compat
+         ./shake-bench
+         ./hls-graph
+         ./hls-plugin-api
+         ./ghcide
+
+-- Standard location for temporary packages needed for particular environments
+-- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script
+-- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml
+optional-packages: vendored/*/*.cabal
+
+
+tests: true
+
+package *
+  -- ghc 8.10 cannot build ghc-lib 9.2 with --haddock
+  -- ghc-options: -haddock
+  test-show-details: direct
+
+write-ghc-environment-files: never
+
+constraints:
+  hyphenation +embed,
+  -- remove this when hlint sets ghc-lib to true by default
+  -- https://github.com/ndmitchell/hlint/issues/1376
+  hlint +ghc-lib,
+  ghc-lib-parser-ex -auto,
+  stylish-haskell +ghc-lib
+
+source-repository-package
+  type:git
+  location: https://github.com/wz1000/hiedb
+  tag: 67b92df2359558091df9102db5b701327308b930
+
+source-repository-package
+  type:git
+  location: https://github.com/wz1000/hie-bios
+  tag: aa73d3d2eb89df0003d2468a105e326d71b62cc7
+
+-- This is benign and won't affect our ability to release to Hackage,
+-- because we only depend on `ekg-json` when a non-default flag
+-- is turned on.
+source-repository-package
+  type:git
+  location: https://github.com/pepeiborra/ekg-json
+  tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460
+
+source-repository-package
+  type:git
+  location: https://github.com/parsonsmatt/cereal
+  tag: b4acf0b778a1d5da305f4de013ce7f32b53d8282
+
+allow-newer:
+  base, ghc-prim, ghc-bignum, ghc, Cabal, binary, bytestring, unix, time, template-haskell,
+  ghc-paths:Cabal,
+  -- for shake-bench
+  Chart:lens,
+  Chart-diagrams:lens,
+
+  -- ghc-9.2
+  ----------
+  hiedb:base,
+
+  ekg-wai:time,
+    -- for shake-bench
+  Chart-diagrams:diagrams-core,
+  SVGFonts:diagrams-core,
+
+  -- https://github.com/lspitzner/multistate/pull/8
+  multistate:base,
+  -- https://github.com/lspitzner/data-tree-print/pull/3
+  data-tree-print:base,
+  -- https://github.com/lspitzner/butcher/pull/8
+  butcher:base,
+
+  implicit-hie-cradle:bytestring,
+  implicit-hie-cradle:time
+
+allow-older:
+  primitive-extras:primitive-unlifted
+
+repository head.hackage.ghc.haskell.org
+   url: https://ghc.gitlab.haskell.org/head.hackage/
+   secure: True
+   key-threshold: 3
+   root-keys:
+       f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
+       26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
+       7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d
+
+active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override

ghcide/ghcide.cabal

@@ -350,7 +350,6 @@ test-suite ghcide-tests
         --------------------------------------------------------------
         ghcide,
         ghcide-test-utils-internal,
-        ghc-typelits-knownnat,
         lsp,
         lsp-types,
         hls-plugin-api,
@@ -378,6 +377,8 @@ test-suite ghcide-tests
       build-depends:
           record-dot-preprocessor,
           record-hasfield
+    if impl(ghc < 9.3)
+       build-depends:  ghc-typelits-knownnat
     hs-source-dirs: test/cabal test/exe bench/lib
     ghc-options: -threaded -Wall -Wno-name-shadowing -O0 -Wno-unticked-promoted-constructors
     main-is: Main.hs

ghcide/session-loader/Development/IDE/Session.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE TypeFamilies              #-}
+{-# LANGUAGE CPP                       #-}
 
 {-|
 The logic for setting up a ghcide session by tapping into hie-bios.
@@ -100,6 +101,10 @@ import           HieDb.Types
 import           HieDb.Utils
 import qualified System.Random                        as Random
 import           System.Random                        (RandomGen)
+import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Debug.Trace
+import Control.Exception (evaluate)
+import Control.DeepSeq
 
 data Log
   = LogSettingInitialDynFlags
@@ -208,11 +213,13 @@ data SessionLoadingOptions = SessionLoadingOptions
   , getCacheDirs           :: String -> [String] -> IO CacheDirs
   -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
   , getInitialGhcLibDir    :: Recorder (WithPriority Log) -> FilePath -> IO (Maybe LibDir)
+#if !MIN_VERSION_ghc(9,3,0)
   , 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
     --   same value as the ghcide fake uid
+#endif
   }
 
 instance Default SessionLoadingOptions where
@@ -221,7 +228,9 @@ instance Default SessionLoadingOptions where
         ,loadCradle = loadWithImplicitCradle
         ,getCacheDirs = getCacheDirsDefault
         ,getInitialGhcLibDir = getInitialGhcLibDirDefault
+#if !MIN_VERSION_ghc(9,3,0)
         ,fakeUid = Compat.toUnitId (Compat.stringToUnit "main")
+#endif
         }
 
 -- | Find the cradle for a given 'hie.yaml' configuration.
@@ -494,7 +503,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
               new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do
                   -- Remove all inplace dependencies from package flags for
                   -- components in this HscEnv
+#if MIN_VERSION_ghc(9,3,0)
+                  let (df2, uids) = (rawComponentDynFlags, [])
+#else
                   let (df2, uids) = removeInplacePackages fakeUid inplace rawComponentDynFlags
+#endif
                   let prefix = show rawComponentUnitId
                   -- See Note [Avoiding bad interface files]
                   let hscComponents = sort $ map show uids
@@ -517,10 +530,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
               -- that I do not fully understand
               log Info $ LogMakingNewHscEnv inplace
               hscEnv <- emptyHscEnv ideNc libDir
-              newHscEnv <-
+              !newHscEnv <-
                 -- Add the options for the current component to the HscEnv
                 evalGhcEnv hscEnv $ do
-                  _ <- setSessionDynFlags $ setHomeUnitId_ fakeUid df
+                  _ <- setSessionDynFlags
+#if !MIN_VERSION_ghc(9,3,0)
+                          $ setHomeUnitId_ fakeUid
+#endif
+                          df
                   getSession
 
               -- Modify the map so the hieYaml now maps to the newly created
@@ -718,7 +735,11 @@ cradleToOptsAndLibDir recorder cradle file = do
             logWith recorder Info $ LogNoneCradleFound file
             return (Left [])
 
+#if MIN_VERSION_ghc(9,3,0)
+emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
+#else
 emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv
+#endif
 emptyHscEnv nc libDir = do
     env <- runGhc (Just libDir) getSession
     initDynLinker env
@@ -757,7 +778,11 @@ toFlagsMap TargetDetails{..} =
     [ (l, (targetEnv, targetDepends)) | l <-  targetLocations]
 
 
+#if MIN_VERSION_ghc(9,3,0)
+setNameCache :: NameCache -> HscEnv -> HscEnv
+#else
 setNameCache :: IORef NameCache -> HscEnv -> HscEnv
+#endif
 setNameCache nc hsc = hsc { hsc_NC = nc }
 
 -- | Create a mapping from FilePaths to HscEnvEqs
@@ -773,6 +798,11 @@ newComponentCache
 newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
     let df = componentDynFlags ci
     hscEnv' <-
+#if MIN_VERSION_ghc(9,3,0)
+      -- Set up a multi component session with the other units on GHC 9.4
+        Compat.initUnits (map snd uids) (hscSetFlags df hsc_env)
+#elif MIN_VERSION_ghc(9,3,0)
+      -- This initializes the units for GHC 9.2
       -- Add the options for the current component to the HscEnv
       -- We want to call `setSessionDynFlags` instead of `hscSetFlags`
       -- because `setSessionDynFlags` also initializes the package database,
@@ -782,14 +812,20 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
       evalGhcEnv hsc_env $ do
         _ <- setSessionDynFlags $ df
         getSession
+#else
+      -- getOptions is enough to initialize units on GHC <9.2
+      pure $ hscSetFlags df hsc_env { hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
+#endif
 
+    traceM "got new hsc env"
 
     let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
     henv <- newFunc hscEnv' uids
     let targetEnv = ([], Just henv)
         targetDepends = componentDependencyInfo ci
         res = (targetEnv, targetDepends)
     logWith recorder Debug $ LogNewComponentCache res
+    evaluate $ liftRnf rwhnf $ componentTargets ci
 
     let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
     ctargets <- concatMapM mk (componentTargets ci)
@@ -998,9 +1034,11 @@ 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.
-    env <- hscSetFlags dflags'' <$> getSession
-    final_env' <- liftIO $ wrapPackageSetupException $ Compat.initUnits env
-    return (hsc_dflags final_env', targets)
+    -- This only works for GHC <9.2
+    -- For GHC >= 9.2, we need to modify the unit env in the hsc_dflags, which
+    -- is done later in newComponentCache
+    final_flags <- liftIO $ wrapPackageSetupException $ Compat.oldInitUnits dflags''
+    return (final_flags, targets)
 
 setIgnoreInterfacePragmas :: DynFlags -> DynFlags
 setIgnoreInterfacePragmas df =