9.6 support

Fixes hls-refactor-plugin 9.6 support hls-gadt-plugin Fix 9.4 build Fixes hls-gadt-plugin fixes WIP 9.6 patches fixes fixes fixes fixes fixes
haskell · Feb 16, 2023 · 6f468b4 · 6f468b4
1 parent f17707c
commit 6f468b4
Show file tree

Hide file tree

Showing 44 changed files with 583 additions and 130 deletions.
diff --git a/cabal.project b/cabal.project
@@ -42,15 +42,36 @@ packages:
 -- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml
 optional-packages: vendored/*/*.cabal
 
-tests: true
+tests: True
+
+if impl(ghc >= 9.5)
+  source-repository-package
+    type:git
+    location: https://github.com/wz1000/HieDb
+    tag: 3efdab5ba67a9cea5bb8c97ed2c52a8929eabaaa
+
+  source-repository-package
+    type:git
+    location: https://github.com/wz1000/retrie
+    tag: 3ad8ca0450ea4619bbc8007251582ffc828faa37
+
+  source-repository-package
+    type:git
+    location: https://github.com/haskell/hie-bios
+    tag: 8519812ad7501cab31347cd46ad1312b8413b8ad
+
+  source-repository-package
+    type:git
+    location: https://github.com/wz1000/ghc-exactprint/
+    tag: 58d88820399b66304f3bb18f0b2602c3a90d5bea
 
 package *
   ghc-options: -haddock
   test-show-details: direct
 
 write-ghc-environment-files: never
 
-index-state: 2023-01-27T00:00:00Z
+index-state: 2023-02-19T00:00:01Z
 
 constraints:
   -- For GHC 9.4, older versions of entropy fail to build on Windows
@@ -66,7 +87,9 @@ constraints:
   ghc-check -ghc-check-use-package-abis,
   ghc-lib-parser-ex -auto,
   stylish-haskell +ghc-lib,
-  fourmolu -fixity-th
+  fourmolu -fixity-th,
+  setup.happy == 1.20.1.1,
+  happy == 1.20.1.1
 
 -- 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
@@ -75,14 +98,18 @@ constraints:
 -- centos7 has an old version of git which cabal doesn't
 -- support. We delete these lines in gitlab ci to workaround
 -- this issue, as this is not necessary to build our binaries.
-source-repository-package
-  type:git
-  location: https://github.com/pepeiborra/ekg-json
-  tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460
-  -- https://github.com/tibbe/ekg-json/pull/12
 -- END DELETE
 
 allow-newer:
+  -- ghc-9.6
+  template-haskell,
+  base,
+  ghc-prim,
+  ghc,
+  ghc-boot,
+  mtl,
+  transformers,
+  Cabal,
   -- ghc-9.4
   Chart-diagrams:lens,
   Chart:lens,
@@ -105,3 +132,15 @@ allow-newer:
   uuid:time,
   vector-space:base,
   ekg-wai:time,
+
+if impl(ghc >= 9.5)
+  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
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -36,6 +36,7 @@ module Development.IDE.Core.Compile
   , TypecheckHelpers(..)
   ) where
 
+import           Control.Monad.IO.Class
 import           Control.Concurrent.Extra
 import           Control.Concurrent.STM.Stats      hiding (orElse)
 import           Control.DeepSeq                   (NFData (..), force, liftRnf,
@@ -133,6 +134,11 @@ import           GHC.Hs                            (LEpaComment)
 import qualified GHC.Types.Error                   as Error
 #endif
 
+#if MIN_VERSION_ghc(9,5,0)
+import GHC.Driver.Config.CoreToStg.Prep
+import GHC.Core.Lint.Interactive
+#endif
+
 -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
 parseModule
     :: IdeOptions
@@ -467,7 +473,11 @@ mkHiFileResultNoCompile session tcm = do
       tcGblEnv = tmrTypechecked tcm
   details <- makeSimpleDetails hsc_env_tmp tcGblEnv
   sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv
-  iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv
+  iface' <- mkIfaceTc hsc_env_tmp sf details ms
+#if MIN_VERSION_ghc(9,5,0)
+                      Nothing
+#endif
+                      tcGblEnv
   let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface]
   pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing
 
@@ -482,20 +492,19 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
       ms = pm_mod_summary $ tmrParsed tcm
       tcGblEnv = tmrTypechecked tcm
 
-  (details, mguts) <-
-    if mg_hsc_src simplified_guts == HsBootFile
-    then do
-        details <- mkBootModDetailsTc session tcGblEnv
-        pure (details, Nothing)
-    else do
+  (details, guts) <- do
         -- write core file
         -- give variables unique OccNames
         tidy_opts <- initTidyOpts session
         (guts, details) <- tidyProgram tidy_opts simplified_guts
-        pure (details, Just guts)
+        pure (details, guts)
 
 #if MIN_VERSION_ghc(9,0,1)
-  let !partial_iface = force $ mkPartialIface session details
+  let !partial_iface = force $ mkPartialIface session
+#if MIN_VERSION_ghc(9,5,0)
+                                              (cg_binds guts)
+#endif
+                                              details
 #if MIN_VERSION_ghc(9,3,0)
                                               ms
 #endif
@@ -513,9 +522,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
   let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface]
 
   -- Write the core file now
-  core_file <- case mguts of
-    Nothing -> pure Nothing -- no guts, likely boot file
-    Just guts -> do
+  core_file <- do
         let core_fp  = ml_core_file $ ms_location ms
             core_file = codeGutsToCoreFile iface_hash guts
             iface_hash = getModuleHash final_iface
@@ -538,27 +545,37 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
     Just (core, _) | optVerifyCoreFile -> do
       let core_fp = ml_core_file $ ms_location ms
       traceIO $ "Verifying " ++ core_fp
-      let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = case mguts of
-            Nothing -> error "invariant optVerifyCoreFile: guts must exist if linkable exists"
-            Just g -> g
+      let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = guts
           mod = ms_mod ms
           data_tycons = filter isDataTyCon tycons
       CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core
 
+#if MIN_VERSION_ghc(9,5,0)
+      cp_cfg <- initCorePrepConfig session
+#endif
+
+      let corePrep = corePrepPgm
+#if MIN_VERSION_ghc(9,5,0)
+                       (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session))
+#else
+                       session
+#endif
+                       mod (ms_location ms)
+
       -- Run corePrep first as we want to test the final version of the program that will
       -- get translated to STG/Bytecode
 #if MIN_VERSION_ghc(9,3,0)
       prepd_binds
 #else
       (prepd_binds , _)
 #endif
-        <- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons
+        <- corePrep unprep_binds data_tycons
 #if MIN_VERSION_ghc(9,3,0)
       prepd_binds'
 #else
       (prepd_binds', _)
 #endif
-        <- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons
+        <- corePrep unprep_binds' data_tycons
       let binds  = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds
           binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds'
 
@@ -683,7 +700,7 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do
                       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
+                      hscInteractive session (mkCgInteractiveGuts guts)
                                 (ms_location summary')
               let unlinked = BCOs bytecode sptEntries
               let linkable = LM time (ms_mod summary) [unlinked]
@@ -1220,7 +1237,9 @@ parseHeader
        => DynFlags -- ^ flags to use
        -> FilePath  -- ^ the filename (for source locations)
        -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
-#if MIN_VERSION_ghc(9,0,1)
+#if MIN_VERSION_ghc(9,5,0)
+       -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
+#elif MIN_VERSION_ghc(9,0,1)
        -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule))
 #else
        -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
@@ -1552,13 +1571,13 @@ showReason (RecompBecause s) = s
 mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails
 mkDetailsFromIface session iface = do
   fixIO $ \details -> do
-    let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details Nothing)) session
+    let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details emptyHomeModInfoLinkable)) session
     initIfaceLoad hsc' (typecheckIface iface)
 
 coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts
 coreFileToCgGuts session iface details core_file = do
   let act hpt = addToHpt hpt (moduleName this_mod)
-                             (HomeModInfo iface details Nothing)
+                             (HomeModInfo iface details emptyHomeModInfoLinkable)
       this_mod = mi_module iface
   types_var <- newIORef (md_types details)
   let hsc_env' = hscUpdateHPT act (session {
@@ -1572,7 +1591,10 @@ coreFileToCgGuts session iface details core_file = do
       -- Implicit binds aren't saved, so we need to regenerate them ourselves.
   let implicit_binds = concatMap getImplicitBinds tyCons
       tyCons = typeEnvTyCons (md_types details)
-#if MIN_VERSION_ghc(9,3,0)
+#if MIN_VERSION_ghc(9,5,0)
+  -- In GHC 9.6, the implicit binds are tidied and part of core_binds
+  pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing []
+#elif MIN_VERSION_ghc(9,3,0)
   pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing []
 #else
   pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing []
@@ -1582,9 +1604,9 @@ coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDet
 coreFileToLinkable linkableType session ms iface details core_file t = do
   cgi_guts <- coreFileToCgGuts session iface details core_file
   (warns, lb) <- case linkableType of
-    BCOLinkable    -> generateByteCode (CoreFileTime t) session ms cgi_guts
-    ObjectLinkable -> generateObjectCode session ms cgi_guts
-  pure (warns, HomeModInfo iface details . Just <$> lb)
+    BCOLinkable    -> fmap (maybe emptyHomeModInfoLinkable justBytecode) <$> generateByteCode (CoreFileTime t) session ms cgi_guts
+    ObjectLinkable -> fmap (maybe emptyHomeModInfoLinkable justObjects) <$> generateObjectCode session ms cgi_guts
+  pure (warns, Just $ HomeModInfo iface details lb) -- TODO wz1000 handle emptyHomeModInfoLinkable
 
 -- | Non-interactive, batch version of 'InteractiveEval.getDocs'.
 --   The interactive paths create problems in ghc-lib builds

diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -63,6 +63,7 @@ module Development.IDE.Core.Rules(
     DisplayTHWarning(..),
     ) where
 
+import           Control.Applicative
 import           Control.Concurrent.Async                     (concurrently)
 import           Control.Concurrent.Strict
 import           Control.DeepSeq
@@ -161,6 +162,9 @@ import Control.Monad.IO.Unlift
 import GHC.Unit.Module.Graph
 import GHC.Unit.Env
 #endif
+#if MIN_VERSION_ghc(9,5,0)
+import GHC.Unit.Home.ModInfo
+#endif
 
 data Log
   = LogShake Shake.Log
@@ -776,7 +780,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
 
             depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
             ifaces <- uses_ GetModIface deps
-            let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces
+            let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
 #if MIN_VERSION_ghc(9,3,0)
             -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph
             -- also points to all the direct descendants of the current module. To get the keys for the descendants
@@ -1100,10 +1104,10 @@ getLinkableRule recorder =
               else pure Nothing
             case mobj_time of
               Just obj_t
-                | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (Just $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file]))
+                | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file]))
               _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (error "object doesn't have time")
         -- Record the linkable so we know not to unload it, and unload old versions
-        whenJust (hm_linkable =<< hmi) $ \(LM time mod _) -> do
+        whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do
             compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction
             liftIO $ modifyVar compiledLinkables $ \old -> do
               let !to_keep = extendModuleEnv old mod time

diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs
@@ -15,6 +15,7 @@
 module Development.IDE.GHC.CPP(doCpp, addOptP)
 where
 
+import           Control.Monad
 import           Development.IDE.GHC.Compat      as Compat
 import           Development.IDE.GHC.Compat.Util
 import           GHC
@@ -41,7 +42,9 @@ addOptP f = alterToolSettings $ \s -> s
 
 doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO ()
 doCpp env raw input_fn output_fn =
-#if MIN_VERSION_ghc (9,2,0)
+#if MIN_VERSION_ghc(9,5,0)
+    void $ Pipeline.runCppPhase env input_fn output_fn -- TODO wz1000
+#elif 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
 #else
     Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn