Skip to content

Commit

Permalink
Use new hie-bios
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Aug 7, 2023
1 parent c3d56ec commit cd9cc3e
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 14 deletions.
5 changes: 5 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,11 @@ packages:
-- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml
optional-packages: vendored/*/*.cabal

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

tests: True

-- mfsolve has duplicate instances in its test suite
Expand Down
28 changes: 14 additions & 14 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,7 @@ data SessionLoadingOptions = SessionLoadingOptions
-- | Load the cradle with an optional 'hie.yaml' location.
-- If a 'hie.yaml' is given, use it to load the cradle.
-- Otherwise, use the provided project root directory to determine the cradle type.
, loadCradle :: Maybe FilePath -> FilePath -> IO (HieBios.Cradle Void)
, loadCradle :: Recorder (WithPriority Log) -> Maybe FilePath -> FilePath -> IO (HieBios.Cradle Void)
-- | Given the project name and a set of command line flags,
-- return the path for storing generated GHC artifacts,
-- or 'Nothing' to respect the cradle setting
Expand Down Expand Up @@ -267,23 +267,24 @@ instance Default SessionLoadingOptions where
-- using the provided root directory for discovering the project.
-- The implicit config uses different heuristics to determine the type
-- of the project that may or may not be accurate.
loadWithImplicitCradle :: Maybe FilePath
loadWithImplicitCradle :: Recorder (WithPriority Log) -> Maybe FilePath
-- ^ Optional 'hie.yaml' location. Will be used if given.
-> FilePath
-- ^ Root directory of the project. Required as a fallback
-- if no 'hie.yaml' location is given.
-> IO (HieBios.Cradle Void)
loadWithImplicitCradle mHieYaml rootDir = do
loadWithImplicitCradle recorder mHieYaml rootDir = do
let logger = toCologActionWithPrio (cmapWithPrio LogHieBios recorder)
case mHieYaml of
Just yaml -> HieBios.loadCradle yaml
Nothing -> HieBios.loadImplicitCradle $ addTrailingPathSeparator rootDir
Just yaml -> HieBios.loadCradle logger yaml
Nothing -> HieBios.loadImplicitCradle logger $ addTrailingPathSeparator rootDir

getInitialGhcLibDirDefault :: Recorder (WithPriority Log) -> FilePath -> IO (Maybe LibDir)
getInitialGhcLibDirDefault recorder rootDir = do
let log = logWith recorder
hieYaml <- findCradle def rootDir
cradle <- loadCradle def hieYaml rootDir
libDirRes <- getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle
cradle <- loadCradle def recorder hieYaml rootDir
libDirRes <- getRuntimeGhcLibDir cradle
case libDirRes of
CradleSuccess libdir -> pure $ Just $ LibDir libdir
CradleFail err -> do
Expand Down Expand Up @@ -614,7 +615,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
when (isNothing hieYaml) $
log Warning $ LogCradleNotFound lfp

cradle <- loadCradle hieYaml dir
cradle <- loadCradle recorder hieYaml dir
lfp <- flip makeRelative cfp <$> getCurrentDirectory

when optTesting $ mRunLspT lspEnv $
Expand Down Expand Up @@ -708,12 +709,11 @@ cradleToOptsAndLibDir recorder cradle file old_files = do
-- noneCradleFoundMessage f = T.pack $ "none cradle found for " <> f <> ", ignoring the file"
-- Start off by getting the session options
logWith recorder Debug $ LogCradle cradle
let logger = toCologActionWithPrio $ cmapWithPrio LogHieBios recorder
cradleRes <- HieBios.getCompilerOptions logger (file:old_files) cradle
cradleRes <- HieBios.getCompilerOptions file old_files cradle
case cradleRes of
CradleSuccess r -> do
-- Now get the GHC lib dir
libDirRes <- getRuntimeGhcLibDir logger cradle
libDirRes <- getRuntimeGhcLibDir cradle
case libDirRes of
-- This is the successful path
CradleSuccess libDir -> pure (Right (r, libDir))
Expand Down Expand Up @@ -814,7 +814,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env old_cis new_cis = do

case closure_errs of
errs@(_:_) -> do
let rendered = map (ideErrorWithSource (Just "cradle") (Just DsError) cfp . T.pack . Compat.printWithoutUniques) errs
let rendered = map (ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) cfp . T.pack . Compat.printWithoutUniques) errs
res = (rendered,Nothing)
dep_info = foldMap componentDependencyInfo (filter isBad $ Map.elems cis)
bad_units = OS.fromList $ concat $ do
Expand Down Expand Up @@ -1104,15 +1104,15 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
(dflags', targets') <- addCmdOpts theOpts dflags
let dflags'' =
#if MIN_VERSION_ghc(9,3,0)
case unitIdString (homeUnitId_ df') of
case unitIdString (homeUnitId_ dflags') of
-- cabal uses main for the unit id of all executable packages
-- This makes multi-component sessions confused about what
-- options to use for that component.
-- Solution: hash the options and use that as part of the unit id
-- This works because there won't be any dependencies on the
-- executable unit.
"main" ->
let hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack $ componentOptions opts)
let hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack $ theOpts)
hashed_uid = Compat.toUnitId (Compat.stringToUnit ("main-"++hash))
in setHomeUnitId_ hashed_uid dflags'
_ -> dflags'
Expand Down

0 comments on commit cd9cc3e

Please sign in to comment.