@@ -38,10 +38,12 @@ import Development.IDE.Core.Shake (getDiagnostics)
38
38
import Data.List (nub )
39
39
import "ghc-lib" GHC hiding (DynFlags (.. ), ms_hspp_opts )
40
40
import "ghc-lib-parser" GHC.LanguageExtensions (Extension )
41
+ import "ghc" DynFlags as RealGHC.DynFlags (topDir )
41
42
import "ghc" GHC as RealGHC (DynFlags (.. ))
42
43
import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags , ms_hspp_opts )
43
44
import qualified "ghc" EnumSet as EnumSet
44
45
import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension )
46
+ import System.Environment (setEnv , unsetEnv )
45
47
import System.FilePath (takeFileName )
46
48
import System.IO (hPutStr , noNewlineTranslation , hSetNewlineMode , utf8 , hSetEncoding , IOMode (WriteMode ), withFile , hClose )
47
49
import System.IO.Temp
@@ -359,6 +361,8 @@ applyHint ide nfp mhint =
359
361
let fp = fromNormalizedFilePath nfp
360
362
(_, mbOldContent) <- liftIO $ runAction' $ getFileContents nfp
361
363
oldContent <- maybe (liftIO $ T. readFile fp) return mbOldContent
364
+ (modsum, _) <- liftIO $ runAction' $ use_ GetModSummary nfp
365
+ let dflags = ms_hspp_opts modsum
362
366
-- set Nothing as "position" for "applyRefactorings" because
363
367
-- applyRefactorings expects the provided position to be _within_ the scope
364
368
-- of each refactoring it will apply.
@@ -380,6 +384,15 @@ applyHint ide nfp mhint =
380
384
hSetEncoding h utf8
381
385
hSetNewlineMode h noNewlineTranslation
382
386
hPutStr h (T. unpack txt)
387
+ -- Setting a environment variable with the libdir used by ghc-exactprint.
388
+ -- It is a workaround for an error caused by the use of a hadcoded at compile time libdir
389
+ -- in ghc-exactprint that makes dependent executables non portables.
390
+ -- See https://github.com/alanz/ghc-exactprint/issues/96.
391
+ -- WARNING: this code is not thread safe, so if you try to apply several async refactorings
392
+ -- it could fail. That case is not very likely so we assume the risk.
393
+ let withRuntimeLibdir :: IO a -> IO a
394
+ withRuntimeLibdir = bracket_ (setEnv key $ topDir dflags) (unsetEnv key)
395
+ where key = " GHC_EXACTPRINT_GHC_LIBDIR"
383
396
res <-
384
397
liftIO $ withSystemTempFile (takeFileName fp) $ \ temp h -> do
385
398
hClose h
@@ -389,7 +402,7 @@ applyHint ide nfp mhint =
389
402
-- We have to reparse extensions to remove the invalid ones
390
403
let (enabled, disabled, _invalid) = parseExtensions $ map show exts
391
404
let refactExts = map show $ enabled ++ disabled
392
- (Right <$> applyRefactorings Nothing commands temp refactExts)
405
+ (Right <$> withRuntimeLibdir ( applyRefactorings Nothing commands temp refactExts) )
393
406
`catches` errorHandlers
394
407
#else
395
408
mbParsedModule <- liftIO $ runAction' $ getParsedModuleWithComments nfp
@@ -399,8 +412,6 @@ applyHint ide nfp mhint =
399
412
Just pm -> do
400
413
let anns = pm_annotations pm
401
414
let modu = pm_parsed_source pm
402
- (modsum, _) <- liftIO $ runAction' $ use_ GetModSummary nfp
403
- let dflags = ms_hspp_opts modsum
404
415
-- apply-refact uses RigidLayout
405
416
let rigidLayout = deltaOptions RigidLayout
406
417
(anns', modu') <-
0 commit comments