Add support for the multi unit argument syntax introduced in GHC 9.4: https://downloads.haskell.org/ghc/9.4.4/docs/users_guide/using.html#multiple-home-units

wz1000 · wz1000 · commit 7ab7989418b8 · 2023-01-23T17:16:36.000+05:30
We now support arguments of the form ``` -unit @unitA -unit @unitb ``` where the response files `unitA` and `unitB` contain the actual list of arguments for that unit: ``` -this-unit-id a-0.1.0.0 -i -isrc A1 A2 ``` Also refactor the session loader and simplify it. Also adds error messages on GHC 9.4 if the units are not closed (#3422).
diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
@@ -165,6 +165,7 @@ library
         Development.IDE.Core.UseStale
         Development.IDE.GHC.Compat
         Development.IDE.GHC.Compat.Core
+        Development.IDE.GHC.Compat.CmdLine
         Development.IDE.GHC.Compat.Env
         Development.IDE.GHC.Compat.Iface
         Development.IDE.GHC.Compat.Logger
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs
@@ -51,6 +51,7 @@ module Development.IDE.GHC.Compat.Env (
     Backend,
     setBackend,
     Development.IDE.GHC.Compat.Env.platformDefaultBackend,
+    workingDirectory
     ) where
 
 import           GHC                  (setInteractiveDynFlags)
@@ -105,6 +106,11 @@ hsc_EPS :: HscEnv -> UnitEnv
 hsc_EPS = hsc_unit_env
 #endif
 
+#if !MIN_VERSION_ghc(9,3,0)
+workingDirectory :: a -> Maybe b
+workingDirectory _ = Nothing
+#endif
+
 #if !MIN_VERSION_ghc(9,2,0)
 type UnitEnv = ()
 newtype Logger = Logger { log_action :: LogAction }
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs
@@ -5,9 +5,7 @@
 module Development.IDE.GHC.Compat.Units (
     -- * UnitState
     UnitState,
-#if MIN_VERSION_ghc(9,3,0)
     initUnits,
-#endif
     oldInitUnits,
     unitState,
     getUnitName,
@@ -179,8 +177,12 @@ initUnits unitDflags env = do
         , ue_eps             = ue_eps (hsc_unit_env env)
         }
   pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env
+#else
+initUnits :: [DynFlags] -> HscEnv -> IO HscEnv
+initUnits _df env = pure env -- Can't do anything here, oldInitUnits should already be called
 #endif
 
+
 -- | oldInitUnits only needs to modify DynFlags for GHC <9.2
 -- For GHC >= 9.2, we need to set the hsc_unit_env also, that is
 -- done later by initUnits
diff --git a/ghcide/test/data/multi-unit/a-1.0.0-inplace b/ghcide/test/data/multi-unit/a-1.0.0-inplace
@@ -0,0 +1,18 @@
+-this-package-name
+a
+-working-dir
+a
+-fbuilding-cabal-package
+-O0
+-i.
+-this-unit-id
+a-1.0.0-inplace
+-hide-all-packages
+-Wmissing-home-modules
+-no-user-package-db
+-package
+base
+-package
+text
+-XHaskell98
+A
diff --git a/ghcide/test/data/multi-unit/a/A.hs b/ghcide/test/data/multi-unit/a/A.hs
@@ -0,0 +1,3 @@
+module A(foo) where
+import Data.Text
+foo = ()
diff --git a/ghcide/test/data/multi-unit/b-1.0.0-inplace b/ghcide/test/data/multi-unit/b-1.0.0-inplace
@@ -0,0 +1,19 @@
+-this-package-name
+b
+-working-dir
+b
+-fbuilding-cabal-package
+-O0
+-i
+-i.
+-this-unit-id
+b-1.0.0-inplace
+-hide-all-packages
+-Wmissing-home-modules
+-no-user-package-db
+-package-id
+a-1.0.0-inplace
+-package
+base
+-XHaskell98
+B
diff --git a/ghcide/test/data/multi-unit/b/B.hs b/ghcide/test/data/multi-unit/b/B.hs
@@ -0,0 +1,3 @@
+module B(module B) where
+import A
+qux = foo
diff --git a/ghcide/test/data/multi-unit/c-1.0.0-inplace b/ghcide/test/data/multi-unit/c-1.0.0-inplace
@@ -0,0 +1,19 @@
+-this-package-name
+c
+-working-dir
+c
+-fbuilding-cabal-package
+-O0
+-i
+-i.
+-this-unit-id
+c-1.0.0-inplace
+-hide-all-packages
+-Wmissing-home-modules
+-no-user-package-db
+-package-id
+a-1.0.0-inplace
+-package
+base
+-XHaskell98
+C
diff --git a/ghcide/test/data/multi-unit/c/C.hs b/ghcide/test/data/multi-unit/c/C.hs
@@ -0,0 +1,3 @@
+module C(module C) where
+import A
+cux = foo
diff --git a/ghcide/test/data/multi-unit/cabal.project b/ghcide/test/data/multi-unit/cabal.project
@@ -0,0 +1,2 @@
+packages: a b c
+multi-repl: True
diff --git a/ghcide/test/data/multi-unit/hie.yaml b/ghcide/test/data/multi-unit/hie.yaml
@@ -0,0 +1,6 @@
+cradle:
+  direct:
+    arguments: ["-unit" ,"@a-1.0.0-inplace"
+               ,"-unit" ,"@b-1.0.0-inplace" 
+               ,"-unit" ,"@c-1.0.0-inplace"
+               ]
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
@@ -2491,7 +2491,7 @@ cradleTests = testGroup "cradle"
     [testGroup "dependencies" [sessionDepsArePickedUp]
     ,testGroup "ignore-fatal" [ignoreFatalWarning]
     ,testGroup "loading" [loadCradleOnlyonce, retryFailedCradle]
-    ,testGroup "multi"   [simpleMultiTest, simpleMultiTest2, simpleMultiTest3, simpleMultiDefTest]
+    ,testGroup "multi"   [simpleMultiTest, simpleMultiTest2, simpleMultiTest3, simpleMultiDefTest, simpleMultiUnitTest]
     ,testGroup "sub-directory"   [simpleSubDirectoryTest]
     ]
 
@@ -2622,6 +2622,24 @@ simpleMultiTest = testCase "simple-multi-test" $ withLongTimeout $ runWithExtraF
     checkDefs locs (pure [fooL])
     expectNoMoreDiagnostics 0.5
 
+-- Test support for loading multiple components as -unit flags as
+-- implemented in GHC 9.4
+simpleMultiUnitTest :: TestTree
+simpleMultiUnitTest = testCase "simple-multi-unit-test" $ withLongTimeout $ runWithExtraFiles "multi-unit" $ \dir -> do
+    let aPath = dir </> "a/A.hs"
+        bPath = dir </> "b/B.hs"
+        cPath = dir </> "c/C.hs"
+    bdoc <- openDoc bPath "haskell"
+    WaitForIdeRuleResult {} <- waitForAction "TypeCheck" bdoc
+    TextDocumentIdentifier auri <- openDoc aPath "haskell"
+    skipManyTill anyMessage $ isReferenceReady aPath
+    cdoc <- openDoc cPath "haskell"
+    WaitForIdeRuleResult {} <- waitForAction "TypeCheck" cdoc
+    locs <- getDefinitions cdoc (Position 2 7)
+    let fooL = mkL auri 2 0 2 3
+    checkDefs locs (pure [fooL])
+    expectNoMoreDiagnostics 0.5
+
 -- Like simpleMultiTest but open the files in the other order
 simpleMultiTest2 :: TestTree
 simpleMultiTest2 = testCase "simple-multi-test2" $ runWithExtraFiles "multi" $ \dir -> do

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+module A(foo) where`
	`2`	`+import Data.Text`
	`3`	`+foo = ()`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+module B(module B) where`
	`2`	`+import A`
	`3`	`+qux = foo`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+module C(module C) where`
	`2`	`+import A`
	`3`	`+cux = foo`