haskell/ghcide
1
1
Fork 0
mirror of https://github.com/haskell/ghcide.git synced 2024-12-02 08:53:07 +03:00
Code Issues Projects Releases Wiki Activity

Obtain the GHC libdir at runtime (#696)

Browse Source 
* Update to hie-bios 0.6.1

* Obtain the GHC libdir at runtime using hie-bios

This replaces hardcoding the GHC libdir path with ghc-paths and instead
gets it at runtime through the hie-bios cradle. This means that the
ghcide binary should be a bit more distributable now, since it won't
rely on paths baked at compile time that are local to the machine it was
compiled on. And we also no longer need the ghcLibCheck since we are
comparing the coompiled and runtime versions with the installationCheck
(ghcVersionChecker)

Co-authored-by: Fendor <power.walross@gmail.com>
This commit is contained in:
Luke Lau 2020-07-20 10:07:23 +01:00 committed by GitHub
parent 251ee08da3
commit ce39ec43c4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 208 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

388
exe/Main.hs
View File

@ -21,7 +21,6 @@ import Control.Monad.IO.Class
import Data.Bifunctor (Bifunctor(second)) import Data.Bifunctor (Bifunctor(second))
import Data.Default import Data.Default
import Data.Either import Data.Either
import Data.Foldable (for_)
import Data.Function import Data.Function
import Data.List.Extra import Data.List.Extra
import Data.Maybe import Data.Maybe
@ -52,12 +51,13 @@ import Data.Aeson (ToJSON(toJSON))
import Development.IDE.LSP.LanguageServer import Development.IDE.LSP.LanguageServer
import qualified System.Directory.Extra as IO import qualified System.Directory.Extra as IO
import System.Environment import System.Environment
import System.Info
import System.IO import System.IO
import System.Exit import System.Exit
import System.FilePath import System.FilePath
import System.Directory import System.Directory
import System.Time.Extra import System.Time.Extra
import HIE.Bios.Environment (addCmdOpts, makeDynFlagsAbsolute) import HIE.Bios.Environment (addCmdOpts, makeDynFlagsAbsolute, getRuntimeGhcLibDir)
import Paths_ghcide import Paths_ghcide
import Development.GitRev import Development.GitRev
import Development.Shake (Action) import Development.Shake (Action)
@ -72,13 +72,15 @@ import GhcMonad
import HscTypes (HscEnv(..), ic_dflags) import HscTypes (HscEnv(..), ic_dflags)
import GHC hiding (def) import GHC hiding (def)
import GHC.Check import GHC.Check
-- Only use this for checking against the compile time GHC libDir!
-- Use getRuntimeGhcLibDir from hie-bios instead for everything else
-- otherwise binaries will not be distributable since paths will be baked into them
import qualified GHC.Paths
import Data.Either.Extra import Data.Either.Extra
import HIE.Bios.Cradle import HIE.Bios.Cradle
import HIE.Bios.Types import HIE.Bios.Types
import Utils
ghcideVersion :: IO String ghcideVersion :: IO String
ghcideVersion = do ghcideVersion = do
path <- getExecutablePath path <- getExecutablePath
@ -192,21 +194,34 @@ showEvent lock e = withLock lock $ print e
-- | Run the specific cradle on a specific FilePath via hie-bios. -- | Run the specific cradle on a specific FilePath via hie-bios.
cradleToSessionOpts :: Cradle a -> FilePath -> IO (Either [CradleError] ComponentOptions) -- This then builds dependencies or whatever based on the cradle, gets the
cradleToSessionOpts cradle file = do -- GHC options/dynflags needed for the session and the GHC library directory
let showLine s = putStrLn ("> " ++ s) cradleToOptsAndLibDir :: Show a => Cradle a -> FilePath
-> IO (Either [CradleError] (ComponentOptions, FilePath))
cradleToOptsAndLibDir cradle file = do
-- Start off by getting the session options
let showLine s = hPutStrLn stderr ("> " ++ s)
hPutStrLn stderr $ "Output from setting up the cradle " <> show cradle
cradleRes <- runCradle (cradleOptsProg cradle) showLine file cradleRes <- runCradle (cradleOptsProg cradle) showLine file
case cradleRes of case cradleRes of
CradleSuccess r -> pure (Right r) CradleSuccess r -> do
-- Now get the GHC lib dir
libDirRes <- getRuntimeGhcLibDir cradle
case libDirRes of
-- This is the successful path
CradleSuccess libDir -> pure (Right (r, libDir))
CradleFail err -> return (Left [err])
-- For the None cradle perhaps we still want to report an Info
-- message about the fact that the file is being ignored.
CradleNone -> return (Left [])
CradleFail err -> return (Left [err]) CradleFail err -> return (Left [err])
-- For the None cradle perhaps we still want to report an Info -- Same here
-- message about the fact that the file is being ignored.
CradleNone -> return (Left []) CradleNone -> return (Left [])
emptyHscEnv :: IORef NameCache -> IO HscEnv emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv
emptyHscEnv nc = do emptyHscEnv nc libDir = do
libdir <- getLibdir env <- runGhc (Just libDir) getSession
env <- runGhc (Just libdir) getSession
initDynLinker env initDynLinker env
pure $ setNameCache nc env pure $ setNameCache nc env
@ -250,181 +265,183 @@ loadSession dir = do
res' <- traverse IO.makeAbsolute res res' <- traverse IO.makeAbsolute res
return $ normalise <$> res' return $ normalise <$> res'
libdir <- getLibdir
installationCheck <- ghcVersionChecker libdir
dummyAs <- async $ return (error "Uninitialised") dummyAs <- async $ return (error "Uninitialised")
runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath]))) runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath])))
case installationCheck of return $ do
InstallationNotFound{..} -> ShakeExtras{logger, eventer, restartShakeSession, withIndefiniteProgress, ideNc} <- getShakeExtras
error $ "GHC installation not found in libdir: " <> libdir IdeOptions{optTesting = IdeTesting optTesting} <- getIdeOptions
InstallationMismatch{..} ->
return $ returnWithVersion $ \fp -> return (([renderPackageSetupException compileTime fp GhcVersionMismatch{..}], Nothing),[])
InstallationChecked compileTime ghcLibCheck -> return $ do
ShakeExtras{logger, eventer, restartShakeSession, withIndefiniteProgress, ideNc} <- getShakeExtras
IdeOptions{optTesting = IdeTesting optTesting} <- getIdeOptions
-- Create a new HscEnv from a hieYaml root and a set of options -- Create a new HscEnv from a hieYaml root and a set of options
-- If the hieYaml file already has an HscEnv, the new component is -- If the hieYaml file already has an HscEnv, the new component is
-- combined with the components in the old HscEnv into a new HscEnv -- combined with the components in the old HscEnv into a new HscEnv
-- which contains the union. -- which contains the union.
let packageSetup :: (Maybe FilePath, NormalizedFilePath, ComponentOptions) let packageSetup :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath)
-> IO (HscEnv, ComponentInfo, [ComponentInfo]) -> IO (HscEnv, ComponentInfo, [ComponentInfo])
packageSetup (hieYaml, cfp, opts) = do packageSetup (hieYaml, cfp, opts, libDir) = do
-- Parse DynFlags for the newly discovered component -- Parse DynFlags for the newly discovered component
hscEnv <- emptyHscEnv ideNc hscEnv <- emptyHscEnv ideNc libDir
(df, targets) <- evalGhcEnv hscEnv $ (df, targets) <- evalGhcEnv hscEnv $
setOptions opts (hsc_dflags hscEnv) setOptions opts (hsc_dflags hscEnv)
let deps = componentDependencies opts ++ maybeToList hieYaml let deps = componentDependencies opts ++ maybeToList hieYaml
dep_info <- getDependencyInfo deps dep_info <- getDependencyInfo deps
-- Now lookup to see whether we are combining with an existing HscEnv -- Now lookup to see whether we are combining with an existing HscEnv
-- or making a new one. The lookup returns the HscEnv and a list of -- or making a new one. The lookup returns the HscEnv and a list of
-- information about other components loaded into the HscEnv -- information about other components loaded into the HscEnv
-- (unitId, DynFlag, Targets) -- (unitId, DynFlag, Targets)
modifyVar hscEnvs $ \m -> do modifyVar hscEnvs $ \m -> do
-- Just deps if there's already an HscEnv -- Just deps if there's already an HscEnv
-- Nothing is it's the first time we are making an HscEnv -- Nothing is it's the first time we are making an HscEnv
let oldDeps = Map.lookup hieYaml m let oldDeps = Map.lookup hieYaml m
let -- Add the raw information about this component to the list let -- Add the raw information about this component to the list
-- We will modify the unitId and DynFlags used for -- We will modify the unitId and DynFlags used for
-- compilation but these are the true source of -- compilation but these are the true source of
-- information. -- information.
new_deps = RawComponentInfo (thisInstalledUnitId df) df targets cfp opts dep_info new_deps = RawComponentInfo (thisInstalledUnitId df) df targets cfp opts dep_info
: maybe [] snd oldDeps : maybe [] snd oldDeps
-- Get all the unit-ids for things in this component -- Get all the unit-ids for things in this component
inplace = map rawComponentUnitId new_deps inplace = map rawComponentUnitId new_deps
new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do
-- Remove all inplace dependencies from package flags for -- Remove all inplace dependencies from package flags for
-- components in this HscEnv -- components in this HscEnv
let (df2, uids) = removeInplacePackages inplace rawComponentDynFlags let (df2, uids) = removeInplacePackages inplace rawComponentDynFlags
let prefix = show rawComponentUnitId let prefix = show rawComponentUnitId
-- See Note [Avoiding bad interface files] -- See Note [Avoiding bad interface files]
processed_df <- setCacheDir logger prefix (sort $ map show uids) opts df2 processed_df <- setCacheDir logger prefix (sort $ map show uids) opts df2
-- The final component information, mostly the same but the DynFlags don't -- The final component information, mostly the same but the DynFlags don't
-- contain any packages which are also loaded -- contain any packages which are also loaded
-- into the same component. -- into the same component.
pure $ ComponentInfo rawComponentUnitId pure $ ComponentInfo rawComponentUnitId
processed_df processed_df
uids uids
rawComponentTargets rawComponentTargets
rawComponentFP rawComponentFP
rawComponentCOptions rawComponentCOptions
rawComponentDependencyInfo rawComponentDependencyInfo
-- Make a new HscEnv, we have to recompile everything from -- Make a new HscEnv, we have to recompile everything from
-- scratch again (for now) -- scratch again (for now)
-- It's important to keep the same NameCache though for reasons -- It's important to keep the same NameCache though for reasons
-- that I do not fully understand -- that I do not fully understand
logInfo logger (T.pack ("Making new HscEnv" ++ show inplace)) logInfo logger (T.pack ("Making new HscEnv" ++ show inplace))
hscEnv <- emptyHscEnv ideNc hscEnv <- emptyHscEnv ideNc libDir
newHscEnv <- newHscEnv <-
-- Add the options for the current component to the HscEnv -- Add the options for the current component to the HscEnv
evalGhcEnv hscEnv $ do evalGhcEnv hscEnv $ do
_ <- setSessionDynFlags df _ <- setSessionDynFlags df
checkSession logger ghcLibCheck getSession
getSession
-- Modify the map so the hieYaml now maps to the newly created -- Modify the map so the hieYaml now maps to the newly created
-- HscEnv -- HscEnv
-- Returns -- Returns
-- . the new HscEnv so it can be used to modify the -- . the new HscEnv so it can be used to modify the
-- FilePath -> HscEnv map (fileToFlags) -- FilePath -> HscEnv map (fileToFlags)
-- . The information for the new component which caused this cache miss -- . The information for the new component which caused this cache miss
-- . The modified information (without -inplace flags) for -- . The modified information (without -inplace flags) for
-- existing packages -- existing packages
pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps')) pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps'))
let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions) -> IO (IdeResult HscEnvEq,[FilePath]) let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath)
session (hieYaml, cfp, opts) = do -> IO (IdeResult HscEnvEq,[FilePath])
(hscEnv, new, old_deps) <- packageSetup (hieYaml, cfp, opts) session args@(hieYaml, _cfp, _opts, _libDir) = do
-- Make a map from unit-id to DynFlags, this is used when trying to (hscEnv, new, old_deps) <- packageSetup args
-- resolve imports. (especially PackageImports) -- Make a map from unit-id to DynFlags, this is used when trying to
let uids = map (\ci -> (componentUnitId ci, componentDynFlags ci)) (new : old_deps) -- resolve imports. (especially PackageImports)
let uids = map (\ci -> (componentUnitId ci, componentDynFlags ci)) (new : old_deps)
-- For each component, now make a new HscEnvEq which contains the -- For each component, now make a new HscEnvEq which contains the
-- HscEnv for the hie.yaml file but the DynFlags for that component -- HscEnv for the hie.yaml file but the DynFlags for that component
-- New HscEnv for the component in question, returns the new HscEnvEq and -- New HscEnv for the component in question, returns the new HscEnvEq and
-- a mapping from FilePath to the newly created HscEnvEq. -- a mapping from FilePath to the newly created HscEnvEq.
let new_cache = newComponentCache logger hscEnv uids let new_cache = newComponentCache logger hscEnv uids
(cs, res) <- new_cache new (cs, res) <- new_cache new
-- Modified cache targets for everything else in the hie.yaml file -- Modified cache targets for everything else in the hie.yaml file
-- which now uses the same EPS and so on -- which now uses the same EPS and so on
cached_targets <- concatMapM (fmap fst . new_cache) old_deps cached_targets <- concatMapM (fmap fst . new_cache) old_deps
modifyVar_ fileToFlags $ \var -> do modifyVar_ fileToFlags $ \var -> do
pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var
-- Invalidate all the existing GhcSession build nodes by restarting the Shake session -- Invalidate all the existing GhcSession build nodes by restarting the Shake session
invalidateShakeCache invalidateShakeCache
restartShakeSession [kick] restartShakeSession [kick]
return (second Map.keys res) return (second Map.keys res)
let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
consultCradle hieYaml cfp = do consultCradle hieYaml cfp = do
when optTesting $ eventer $ notifyCradleLoaded cfp when optTesting $ eventer $ notifyCradleLoaded cfp
logInfo logger $ T.pack ("Consulting the cradle for " <> show cfp) logInfo logger $ T.pack ("Consulting the cradle for " <> show cfp)
cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
-- Display a user friendly progress message here: They probably don't know what a -- Display a user friendly progress message here: They probably don't know what a
-- cradle is -- cradle is
let progMsg = "Setting up project " <> T.pack (takeBaseName (cradleRootDir cradle)) let progMsg = "Setting up project " <> T.pack (takeBaseName (cradleRootDir cradle))
eopts <- withIndefiniteProgress progMsg LSP.NotCancellable $
cradleToSessionOpts cradle cfp
logDebug logger $ T.pack ("Session loading result: " <> show eopts)
case eopts of
-- The cradle gave us some options so get to work turning them
-- into and HscEnv.
Right opts -> do
session (hieYaml, toNormalizedFilePath' cfp, opts)
-- Failure case, either a cradle error or the none cradle
Left err -> do
dep_info <- getDependencyInfo (maybeToList hieYaml)
let ncfp = toNormalizedFilePath' cfp
let res = (map (renderCradleError ncfp) err, Nothing)
modifyVar_ fileToFlags $ \var -> do
pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var
return (res,[])
-- This caches the mapping from hie.yaml + Mod.hs -> [String]
-- Returns the Ghc session and the cradle dependencies
let sessionOpts :: (Maybe FilePath, FilePath) -> IO (IdeResult HscEnvEq, [FilePath])
sessionOpts (hieYaml, file) = do
v <- fromMaybe HM.empty . Map.lookup hieYaml <$> readVar fileToFlags
cfp <- canonicalizePath file
case HM.lookup (toNormalizedFilePath' cfp) v of
Just (opts, old_di) -> do
deps_ok <- checkDependencyInfo old_di
if not deps_ok
then do
-- If the dependencies are out of date then clear both caches and start
-- again.
modifyVar_ fileToFlags (const (return Map.empty))
-- Keep the same name cache
modifyVar_ hscEnvs (return . Map.adjust (\(h, _) -> (h, [])) hieYaml )
consultCradle hieYaml cfp
else return (opts, Map.keys old_di)
Nothing -> consultCradle hieYaml cfp
-- The main function which gets options for a file. We only want one of these running eopts <- withIndefiniteProgress progMsg LSP.NotCancellable $
-- at a time. Therefore the IORef contains the currently running cradle, if we try cradleToOptsAndLibDir cradle cfp
-- to get some more options then we wait for the currently running action to finish
-- before attempting to do so.
let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
getOptions file = do
hieYaml <- cradleLoc file
sessionOpts (hieYaml, file) `catch` \e ->
return (([renderPackageSetupException compileTime file e], Nothing),[])
returnWithVersion $ \file -> do logDebug logger $ T.pack ("Session loading result: " <> show eopts)
liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do case eopts of
-- If the cradle is not finished, then wait for it to finish. -- The cradle gave us some options so get to work turning them
void $ wait as -- into and HscEnv.
as <- async $ getOptions file Right (opts, libDir) -> do
return (as, wait as) installationCheck <- ghcVersionChecker libDir
case installationCheck of
InstallationNotFound{..} ->
error $ "GHC installation not found in libdir: " <> libdir
InstallationMismatch{..} ->
return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
InstallationChecked _compileTime _ghcLibCheck ->
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
-- Failure case, either a cradle error or the none cradle
Left err -> do
dep_info <- getDependencyInfo (maybeToList hieYaml)
let ncfp = toNormalizedFilePath' cfp
let res = (map (renderCradleError ncfp) err, Nothing)
modifyVar_ fileToFlags $ \var -> do
pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var
return (res,[])
-- This caches the mapping from hie.yaml + Mod.hs -> [String]
-- Returns the Ghc session and the cradle dependencies
let sessionOpts :: (Maybe FilePath, FilePath) -> IO (IdeResult HscEnvEq, [FilePath])
sessionOpts (hieYaml, file) = do
v <- fromMaybe HM.empty . Map.lookup hieYaml <$> readVar fileToFlags
cfp <- canonicalizePath file
case HM.lookup (toNormalizedFilePath' cfp) v of
Just (opts, old_di) -> do
deps_ok <- checkDependencyInfo old_di
if not deps_ok
then do
-- If the dependencies are out of date then clear both caches and start
-- again.
modifyVar_ fileToFlags (const (return Map.empty))
-- Keep the same name cache
modifyVar_ hscEnvs (return . Map.adjust (\(h, _) -> (h, [])) hieYaml )
consultCradle hieYaml cfp
else return (opts, Map.keys old_di)
Nothing -> consultCradle hieYaml cfp
-- The main function which gets options for a file. We only want one of these running
-- at a time. Therefore the IORef contains the currently running cradle, if we try
-- to get some more options then we wait for the currently running action to finish
-- before attempting to do so.
let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
getOptions file = do
hieYaml <- cradleLoc file
sessionOpts (hieYaml, file) `catch` \e ->
return (([renderPackageSetupException file e], Nothing),[])
returnWithVersion $ \file -> do
liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do
-- If the cradle is not finished, then wait for it to finish.
void $ wait as
as <- async $ getOptions file
return (as, wait as)
-- | Create a mapping from FilePaths to HscEnvEqs -- | Create a mapping from FilePaths to HscEnvEqs
newComponentCache newComponentCache
@ -692,16 +709,7 @@ cradleLoadedMethod = "ghcide/cradle/loaded"
---------------------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------------------
ghcVersionChecker :: GhcVersionChecker ghcVersionChecker :: GhcVersionChecker
ghcVersionChecker = $$(makeGhcVersionChecker getLibdir) ghcVersionChecker = $$(makeGhcVersionChecker (fromMaybe GHC.Paths.libdir <$> lookupEnv "NIX_GHC_LIBDIR"))
-- | Throws a 'PackageSetupException' if the 'Session' cannot be used by ghcide
checkSession :: Logger -> Ghc PackageCheckResult -> Ghc ()
checkSession logger ghcLibCheck =
ghcLibCheck >>= \res -> case guessCompatibility res of
ProbablyCompatible mbWarning ->
for_ mbWarning $ liftIO . logInfo logger . T.pack
NotCompatible err ->
liftIO $ throwIO $ PackageCheckFailed err
data PackageSetupException data PackageSetupException
= PackageSetupException = PackageSetupException
@ -722,31 +730,31 @@ wrapPackageSetupException = handleAny $ \case
e | Just (pkgE :: PackageSetupException) <- fromException e -> throwIO pkgE e | Just (pkgE :: PackageSetupException) <- fromException e -> throwIO pkgE
e -> (throwIO . PackageSetupException . show) e e -> (throwIO . PackageSetupException . show) e
showPackageSetupException :: Version -> PackageSetupException -> String showPackageSetupException :: PackageSetupException -> String
showPackageSetupException _ GhcVersionMismatch{..} = unwords showPackageSetupException GhcVersionMismatch{..} = unwords
["ghcide compiled against GHC" ["ghcide compiled against GHC"
,showVersion compileTime ,showVersion compileTime
,"but currently using" ,"but currently using"
,showVersion runTime ,showVersion runTime
,"\nThis is unsupported, ghcide must be compiled with the same GHC version as the project." ,"\nThis is unsupported, ghcide must be compiled with the same GHC version as the project."
] ]
showPackageSetupException compileTime PackageSetupException{..} = unwords showPackageSetupException PackageSetupException{..} = unwords
[ "ghcide compiled by GHC", showVersion compileTime [ "ghcide compiled by GHC", showVersion compilerVersion
, "failed to load packages:", message <> "." , "failed to load packages:", message <> "."
, "\nPlease ensure that ghcide is compiled with the same GHC installation as the project."] , "\nPlease ensure that ghcide is compiled with the same GHC installation as the project."]
showPackageSetupException _ (PackageCheckFailed PackageVersionMismatch{..}) = unwords showPackageSetupException (PackageCheckFailed PackageVersionMismatch{..}) = unwords
["ghcide compiled with package " ["ghcide compiled with package "
, packageName <> "-" <> showVersion compileTime , packageName <> "-" <> showVersion compileTime
,"but project uses package" ,"but project uses package"
, packageName <> "-" <> showVersion runTime , packageName <> "-" <> showVersion runTime
,"\nThis is unsupported, ghcide must be compiled with the same GHC installation as the project." ,"\nThis is unsupported, ghcide must be compiled with the same GHC installation as the project."
] ]
showPackageSetupException _ (PackageCheckFailed BasePackageAbiMismatch{..}) = unwords showPackageSetupException (PackageCheckFailed BasePackageAbiMismatch{..}) = unwords
["ghcide compiled with base-" <> showVersion compileTime <> "-" <> compileTimeAbi ["ghcide compiled with base-" <> showVersion compileTime <> "-" <> compileTimeAbi
,"but project uses base-" <> showVersion compileTime <> "-" <> runTimeAbi ,"but project uses base-" <> showVersion compileTime <> "-" <> runTimeAbi
,"\nThis is unsupported, ghcide must be compiled with the same GHC installation as the project." ,"\nThis is unsupported, ghcide must be compiled with the same GHC installation as the project."
] ]
renderPackageSetupException :: Version -> FilePath -> PackageSetupException -> (NormalizedFilePath, ShowDiagnostic, Diagnostic) renderPackageSetupException :: FilePath -> PackageSetupException -> (NormalizedFilePath, ShowDiagnostic, Diagnostic)
renderPackageSetupException compileTime fp e = renderPackageSetupException fp e =
ideErrorWithSource (Just "cradle") (Just DsError) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException compileTime e) ideErrorWithSource (Just "cradle") (Just DsError) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e)

9
exe/Utils.hs
View File

@ -1,9 +0,0 @@
module Utils (getLibdir) where
import qualified GHC.Paths
import System.Environment
import Data.Maybe
-- Set the GHC libdir to the nix libdir if it's present.
getLibdir :: IO FilePath
getLibdir = fromMaybe GHC.Paths.libdir <$> lookupEnv "NIX_GHC_LIBDIR"

1
ghcide.cabal
View File

@ -267,7 +267,6 @@ executable ghcide
text, text,
unordered-containers unordered-containers
other-modules: other-modules:
Utils
Arguments Arguments
Paths_ghcide Paths_ghcide

11
test/exe/Main.hs
View File

@ -40,7 +40,8 @@ import Language.Haskell.LSP.VFS (applyChange)
import Network.URI import Network.URI
import System.Environment.Blank (getEnv, setEnv, unsetEnv) import System.Environment.Blank (getEnv, setEnv, unsetEnv)
import System.FilePath import System.FilePath
import System.IO.Extra import System.IO.Extra hiding (withTempDir)
import qualified System.IO.Extra
import System.Directory import System.Directory
import System.Exit (ExitCode(ExitSuccess)) import System.Exit (ExitCode(ExitSuccess))
import System.Process.Extra (readCreateProcessWithExitCode, CreateProcess(cwd), proc) import System.Process.Extra (readCreateProcessWithExitCode, CreateProcess(cwd), proc)
@ -3010,3 +3011,11 @@ getWatchedFilesSubscriptionsUntil = do
| Just RequestMessage{_params = RegistrationParams (List regs)} <- msgs | Just RequestMessage{_params = RegistrationParams (List regs)} <- msgs
, Registration _id WorkspaceDidChangeWatchedFiles args <- regs , Registration _id WorkspaceDidChangeWatchedFiles args <- regs
] ]
-- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path
-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
-- @/var@
withTempDir :: (FilePath -> IO a) -> IO a
withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
dir' <- canonicalizePath dir
f dir'