Skip to content

Commit

Permalink
Add support for the multi unit argument syntax introduced in GHC 9.4: h…
Browse files Browse the repository at this point in the history
…ttps://downloads.haskell.org/ghc/9.4.4/docs/users_guide/using.html#multiple-home-units

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).
  • Loading branch information
wz1000 committed Jan 23, 2023
1 parent ddc67b2 commit 7ab7989
Show file tree
Hide file tree
Showing 13 changed files with 276 additions and 118 deletions.
1 change: 1 addition & 0 deletions ghcide/ghcide.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
288 changes: 173 additions & 115 deletions ghcide/session-loader/Development/IDE/Session.hs

Large diffs are not rendered by default.

6 changes: 6 additions & 0 deletions ghcide/src/Development/IDE/GHC/Compat/Env.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ module Development.IDE.GHC.Compat.Env (
Backend,
setBackend,
Development.IDE.GHC.Compat.Env.platformDefaultBackend,
workingDirectory
) where

import GHC (setInteractiveDynFlags)
Expand Down Expand Up @@ -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 }
Expand Down
6 changes: 4 additions & 2 deletions ghcide/src/Development/IDE/GHC/Compat/Units.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,7 @@
module Development.IDE.GHC.Compat.Units (
-- * UnitState
UnitState,
#if MIN_VERSION_ghc(9,3,0)
initUnits,
#endif
oldInitUnits,
unitState,
getUnitName,
Expand Down Expand Up @@ -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
Expand Down
18 changes: 18 additions & 0 deletions ghcide/test/data/multi-unit/a-1.0.0-inplace
Original file line number Diff line number Diff line change
@@ -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
3 changes: 3 additions & 0 deletions ghcide/test/data/multi-unit/a/A.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
module A(foo) where
import Data.Text
foo = ()
19 changes: 19 additions & 0 deletions ghcide/test/data/multi-unit/b-1.0.0-inplace
Original file line number Diff line number Diff line change
@@ -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
3 changes: 3 additions & 0 deletions ghcide/test/data/multi-unit/b/B.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
module B(module B) where
import A
qux = foo
19 changes: 19 additions & 0 deletions ghcide/test/data/multi-unit/c-1.0.0-inplace
Original file line number Diff line number Diff line change
@@ -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
3 changes: 3 additions & 0 deletions ghcide/test/data/multi-unit/c/C.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
module C(module C) where
import A
cux = foo
2 changes: 2 additions & 0 deletions ghcide/test/data/multi-unit/cabal.project
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
packages: a b c
multi-repl: True
6 changes: 6 additions & 0 deletions ghcide/test/data/multi-unit/hie.yaml
Original file line number Diff line number Diff line change
@@ -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"
]
20 changes: 19 additions & 1 deletion ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
]

Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 7ab7989

Please sign in to comment.