Skip to content

Commit

Permalink
9.4 support + MHU
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Jun 28, 2022
1 parent 44be741 commit 7f5bd1d
Show file tree
Hide file tree
Showing 36 changed files with 1,048 additions and 145 deletions.
91 changes: 91 additions & 0 deletions cabal-941.project
Original file line number Diff line number Diff line change
@@ -0,0 +1,91 @@
packages:
./hie-compat
./shake-bench
./hls-graph
./ghcide
./hls-plugin-api

tests: false

-- 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: false

package *
-- ghc 8.10 cannot build ghc-lib 9.2 with --haddock
-- ghc-options: -haddock
test-show-details: direct

write-ghc-environment-files: never

index-state: 2022-06-12T00:00:00Z
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,

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: 217dd47246ce0708b0152c78b3c6268373824a22

source-repository-package
type:git
location: https://github.com/wz1000/hie-bios
tag: 0e1b0f8e0a77ef6d203d725dd2bae364dc3466f2

-- 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

allow-newer:
-- 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
9 changes: 6 additions & 3 deletions ghcide/ghcide.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ library
filepath,
fingertree,
focus,
ghc-exactprint,
-- ghc-exactprint,
ghc-trace-events,
Glob,
haddock-library >= 1.8 && < 1.11,
Expand All @@ -80,7 +80,6 @@ library
prettyprinter >= 1.6,
random,
regex-tdfa >= 1.3.1.0,
retrie,
rope-utf16-splay,
safe,
safe-exceptions,
Expand Down Expand Up @@ -113,7 +112,11 @@ library
hie-bios ^>= 0.9.1,
implicit-hie-cradle ^>= 0.3.0.5 || ^>= 0.5,
base16-bytestring >=0.1.1 && <1.1
if impl(ghc >= 9.2)
if impl(ghc < 9.3)
build-depends:
retrie,
ghc-exactprint
if impl(ghc >= 9.2 && < 9.3)
build-depends:
ghc-exactprint >= 1.4
if os(windows)
Expand Down
47 changes: 42 additions & 5 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
@@ -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.
Expand Down Expand Up @@ -100,6 +101,9 @@ import HieDb.Utils
import System.Random (RandomGen)
import qualified System.Random as Random
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Debug.Trace
import Control.Exception (evaluate)
import Control.DeepSeq

data Log
= LogSettingInitialDynFlags
Expand Down Expand Up @@ -208,11 +212,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
Expand All @@ -221,7 +227,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.
Expand Down Expand Up @@ -494,7 +502,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
Expand All @@ -517,10 +529,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
Expand Down Expand Up @@ -718,7 +734,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
Expand Down Expand Up @@ -757,7 +777,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
Expand All @@ -773,6 +797,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,
Expand All @@ -782,14 +811,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)
Expand Down Expand Up @@ -998,9 +1033,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 =
Expand Down
Loading

0 comments on commit 7f5bd1d

Please sign in to comment.