Skip to content

Commit 559f1ba

Browse files
tittoassinitittoassini
committed
formatting fixes, simplified import paths detection
1 parent 18eb68d commit 559f1ba

File tree

1 file changed

+63
-78
lines changed

1 file changed

+63
-78
lines changed

‎plugins/default/src/Ide/Plugin/Eval/CodeLens.hs

Lines changed: 63 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ import Data.List (
5050
import Data.Maybe (
5151
catMaybes,
5252
fromMaybe,
53-
maybeToList,
5453
)
5554
import Data.String (IsString)
5655
import Data.Text (Text)
@@ -69,7 +68,6 @@ import Development.IDE (
6968
Uri,
7069
evalGhcEnv,
7170
hscEnvWithImportPaths,
72-
moduleImportPath,
7371
runAction,
7472
stringBufferToByteString,
7573
textToStringBuffer,
@@ -154,6 +152,7 @@ import Ide.Plugin.Eval.GHC (
154152
addPackages,
155153
hasPackage,
156154
isExpr,
155+
extra siplisimpliss showDynFlags,
157156
)
158157
import Ide.Plugin.Eval.Parse.Option (langOptions)
159158
import Ide.Plugin.Eval.Parse.Section (
@@ -347,80 +346,66 @@ runEvalCmd lsp st EvalParams{..} =
347346
(Just (textToStringBuffer mdlText, now))
348347

349348
-- Setup environment for evaluation
350-
hscEnv' <-
351-
withSystemTempFile (takeFileName fp) $ \logFilename logHandle ->
352-
ExceptT $
353-
(either Left id <$>)
354-
. gStrictTry
355-
$ evalGhcEnv (hscEnvWithImportPaths session) $
356-
do
357-
env <- getSession
358-
359-
-- Install the module pragmas and options
360-
df <- liftIO $ setupDynFlagsForGHCiLike env $ ms_hspp_opts ms
361-
362-
-- Desperately looking for an import path
363-
let impPaths0 = envImportPaths session
364-
impPaths1 = if null (importPaths df) then Nothing else Just (importPaths df)
365-
impPaths2 = maybeToList $ moduleImportPath nfp modName
366-
impPaths = fromMaybe impPaths2 $ impPaths0 <> impPaths1
367-
dbg "importPaths0" impPaths0
368-
dbg "importPaths1" impPaths1
369-
dbg "importPaths2" impPaths2
370-
dbg "importPaths" impPaths
371-
-- Restore the cradle import paths
372-
df <- return df{importPaths = impPaths}
373-
374-
-- Set the modified flags in the session
375-
_lp <- setSessionDynFlags df
376-
377-
-- property tests need QuickCheck
378-
when (needsQuickCheck tests) $ void $ addPackages ["QuickCheck"]
379-
dbg "QUICKCHECK NEEDS" $ needsQuickCheck tests
380-
dbg "QUICKCHECK HAS" $ hasQuickCheck df
381-
382-
-- copy the package state to the interactive DynFlags
383-
idflags <- getInteractiveDynFlags
384-
df <- getSessionDynFlags
385-
setInteractiveDynFlags $
386-
(foldl xopt_set idflags evalExtensions)
387-
{ pkgState =
388-
pkgState
389-
df
390-
, pkgDatabase =
391-
pkgDatabase
392-
df
393-
, packageFlags =
394-
packageFlags
395-
df
396-
, useColor = Never
397-
, canUseColor = False
398-
}
399-
400-
-- set up a custom log action
401-
setLogAction $ \_df _wr _sev _span _style _doc ->
402-
defaultLogActionHPutStrDoc _df logHandle _doc _style
403-
404-
-- Load the module with its current content (as the saved module might not be up to date)
405-
-- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8
406-
-- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066
407-
-- and https://hackage.haskell.org/package/ghc-8.10.1/docs/GHC.html#v:TargetFile
408-
eSetTarget <- gStrictTry $ setTargets [thisModuleTarget]
409-
dbg "setTarget" eSetTarget
410-
411-
-- load the module in the interactive environment
412-
loadResult <- perf "loadModule" $ load LoadAllTargets
413-
dbg "LOAD RESULT" $ asS loadResult
414-
case loadResult of
415-
Failed -> liftIO $ do
416-
hClose logHandle
417-
err <- readFile logFilename
418-
dbg "load ERR" err
419-
return $ Left err
420-
Succeeded -> do
421-
-- Evaluation takes place 'inside' the module
422-
setContext [IIModule modName]
423-
Right <$> getSession
349+
hscEnv' <- withSystemTempFile (takeFileName fp) $ \logFilename logHandle -> ExceptT . (either Left id <$>) . gStrictTry . evalGhcEnv (hscEnvWithImportPaths session) $ do
350+
env <- getSession
351+
352+
-- Install the module pragmas and options
353+
df <- liftIO $ setupDynFlagsForGHCiLike env $ ms_hspp_opts ms
354+
355+
let impPaths = fromMaybe (importPaths df) (envImportPaths session)
356+
-- Restore the cradle import paths
357+
df <- return df{importPaths = impPaths}
358+
359+
-- Set the modified flags in the session
360+
_lp <- setSessionDynFlags df
361+
362+
-- property tests need QuickCheck
363+
when (needsQuickCheck tests) $ void $ addPackages ["QuickCheck"]
364+
dbg "QUICKCHECK NEEDS" $ needsQuickCheck tests
365+
dbg "QUICKCHECK HAS" $ hasQuickCheck df
366+
367+
-- copy the package state to the interactive DynFlags
368+
idflags <- getInteractiveDynFlags
369+
df <- getSessionDynFlags
370+
setInteractiveDynFlags $
371+
(foldl xopt_set idflags evalExtensions)
372+
{ pkgState =
373+
pkgState
374+
df
375+
, pkgDatabase =
376+
pkgDatabase
377+
df
378+
, packageFlags =
379+
packageFlags
380+
df
381+
, useColor = Never
382+
, canUseColor = False
383+
}
384+
385+
-- set up a custom log action
386+
setLogAction $ \_df _wr _sev _span _style _doc ->
387+
defaultLogActionHPutStrDoc _df logHandle _doc _style
388+
389+
-- Load the module with its current content (as the saved module might not be up to date)
390+
-- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8
391+
-- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066
392+
-- and https://hackage.haskell.org/package/ghc-8.10.1/docs/GHC.html#v:TargetFile
393+
eSetTarget <- gStrictTry $ setTargets [thisModuleTarget]
394+
dbg "setTarget" eSetTarget
395+
396+
-- load the module in the interactive environment
397+
loadResult <- perf "loadModule" $ load LoadAllTargets
398+
dbg "LOAD RESULT" $ asS loadResult
399+
case loadResult of
400+
Failed -> liftIO $ do
401+
hClose logHandle
402+
err <- readFile logFilename
403+
dbg "load ERR" err
404+
return $ Left err
405+
Succeeded -> do
406+
-- Evaluation takes place 'inside' the module
407+
setContext [IIModule modName]
408+
Right <$> getSession
424409

425410
edits <-
426411
perf "edits" $
@@ -556,10 +541,10 @@ evals (st, fp) df stmts = do
556541
( \es -> do
557542
dbg "{:SET" es
558543
ndf <- getInteractiveDynFlags
559-
dbg "pre set" ndf
544+
dbg "pre set" $ showDynFlags ndf
560545
mapM_ addExtension es
561546
ndf <- getInteractiveDynFlags
562-
dbg "post set" ndf
547+
dbg "post set" $ showDynFlags ndf
563548
return Nothing
564549
)
565550
$ ghcOptions stmt

0 commit comments

Comments
 (0)