haskell/ghcide
1
1
Fork 0
mirror of https://github.com/haskell/ghcide.git synced 2024-09-11 05:36:09 +03:00
Code Issues Projects Releases Wiki Activity

Import paths are relative to cradle (#781)

Browse Source 
* Import paths are relative to cradle

I noticed ghcide HEAD was broken on the ghcide submodule of the hls repo.

* remove unused

* Fix comment placement

* Special case the implicit cradle

The implicit cradle comes without import paths, so we need to preserve the old
logic that synthetised them from the current module

* Hlint

* Fix timing issue: update known files before restarting the session

Also, DO NOT filter out missing targets

* Use --verbose when running tests

* Log test outputs on 3rd attempt

* Fall back to filtering known files

* hlint

* Upgrade KnownFiles to KnownTargets

* Use KnownTargets to filter modules, not module paths

* Fix test cradle

* Increase pauses in flaky test

* remove no longer needed check

* Disable ansi color codes in CI

* Disable flaky test
This commit is contained in:
Pepe Iborra 2020-09-12 10:01:01 +01:00 committed by GitHub
parent 15ab2ff3ac
commit 7dacc236ea
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 167 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.azure/linux-stack.yml
View File

@ -45,7 +45,7 @@ jobs:
displayName: 'stack build --only-dependencies'
- bash: |
export PATH=/opt/cabal/bin:$PATH
stack test --ghc-options=-Werror --stack-yaml=$STACK_YAML || stack test --ghc-options=-Werror --stack-yaml=$STACK_YAML|| stack test --ghc-options=-Werror --stack-yaml=$STACK_YAML
stack test --ghc-options=-Werror --stack-yaml=$STACK_YAML || stack test --ghc-options=-Werror --stack-yaml=$STACK_YAML|| LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true stack test --ghc-options=-Werror --stack-yaml=$STACK_YAML
# ghcide stack tests are flaky, see https://github.com/digital-asset/daml/issues/2606.
displayName: 'stack test --ghc-options=-Werror'
- bash: |

112
session-loader/Development/IDE/Session.hs
View File

@ -25,7 +25,6 @@ import Data.Bifunctor
import qualified Data.ByteString.Base16 as B16
import Data.Either.Extra
import Data.Function
import qualified Data.HashSet as HashSet
import Data.Hashable
import Data.List
import Data.IORef
@ -65,6 +64,7 @@ import Module
import NameCache
import Packages
import Control.Exception (evaluate)
import Data.Char
-- | Given a root directory, return a Shake 'Action' which setups an
-- 'IdeGhcSession' given a file.
@ -104,7 +104,7 @@ loadSession dir = do
return $ do
extras@ShakeExtras{logger, eventer, restartShakeSession,
withIndefiniteProgress, ideNc, knownFilesVar
withIndefiniteProgress, ideNc, knownTargetsVar
} <- getShakeExtras
IdeOptions{ optTesting = IdeTesting optTesting
@ -112,6 +112,20 @@ loadSession dir = do
, optCustomDynFlags
} <- getIdeOptions
-- populate the knownTargetsVar with all the
-- files in the project so that `knownFiles` can learn about them and
-- we can generate a complete module graph
let extendKnownTargets newTargets = do
knownTargets <- forM newTargets $ \TargetDetails{..} -> do
found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations
return (targetModule, found)
modifyVar_ knownTargetsVar $ traverseHashed $ \known -> do
let known' = HM.unionWith (<>) known $ HM.fromList knownTargets
when (known /= known') $
logDebug logger $ "Known files updated: " <>
T.pack(show $ (HM.map . map) fromNormalizedFilePath known')
evaluate known'
-- 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
-- combined with the components in the old HscEnv into a new HscEnv
@ -212,20 +226,26 @@ loadSession dir = do
-- New HscEnv for the component in question, returns the new HscEnvEq and
-- a mapping from FilePath to the newly created HscEnvEq.
let new_cache = newComponentCache logger isImplicit hscEnv uids
isImplicit = isNothing hieYaml
let new_cache = newComponentCache logger hieYaml hscEnv uids
(cs, res) <- new_cache new
-- Modified cache targets for everything else in the hie.yaml file
-- which now uses the same EPS and so on
cached_targets <- concatMapM (fmap fst . new_cache) old_deps
let all_targets = cs ++ cached_targets
modifyVar_ fileToFlags $ \var -> do
pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var
pure $ Map.insert hieYaml (HM.fromList (concatMap toFlagsMap all_targets)) var
extendKnownTargets all_targets
-- Invalidate all the existing GhcSession build nodes by restarting the Shake session
invalidateShakeCache
restartShakeSession [kick]
return (map fst cs ++ map fst cached_targets, second Map.keys res)
let resultCachedTargets = concatMap targetLocations all_targets
return (resultCachedTargets, second Map.keys res)
let consultCradle :: Maybe FilePath -> FilePath -> IO ([NormalizedFilePath], (IdeResult HscEnvEq, [FilePath]))
consultCradle hieYaml cfp = do
@ -299,14 +319,10 @@ loadSession dir = do
void $ wait as
as <- async $ getOptions file
return (fmap snd as, wait as)
unless (null cs) $
unless (null cs) $ do
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cs
-- Typecheck all files in the project on startup
void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cs
-- populate the knownFilesVar with all the
-- files in the project so that `knownFiles` can learn about them and
-- we can generate a complete module graph
liftIO $ modifyVar_ knownFilesVar $ traverseHashed $ pure . HashSet.union (HashSet.fromList cfps')
when checkProject $ do
mmt <- uses GetModificationTime cfps'
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
@ -320,6 +336,7 @@ loadSession dir = do
-- | Run the specific cradle on a specific FilePath via hie-bios.
-- This then builds dependencies or whatever based on the cradle, gets the
-- GHC options/dynflags needed for the session and the GHC library directory
cradleToOptsAndLibDir :: Show a => Cradle a -> FilePath
-> IO (Either [CradleError] (ComponentOptions, FilePath))
cradleToOptsAndLibDir cradle file = do
@ -349,52 +366,79 @@ emptyHscEnv nc libDir = do
initDynLinker env
pure $ setNameCache nc env
-- | Convert a target to a list of potential absolute paths.
-- A TargetModule can be anywhere listed by the supplied include
-- directories
-- A target file is a relative path but with a specific prefix so just need
-- to canonicalise it.
targetToFile :: [FilePath] -> TargetId -> IO [NormalizedFilePath]
targetToFile is (TargetModule mod) = do
data TargetDetails = TargetDetails
{
targetModule :: !ModuleName,
targetEnv :: !(IdeResult HscEnvEq),
targetDepends :: !DependencyInfo,
targetLocations :: ![NormalizedFilePath]
}
fromTargetId :: [FilePath] -- ^ import paths
-> TargetId
-> IdeResult HscEnvEq
-> DependencyInfo
-> IO [TargetDetails]
-- For a target module we consider all the import paths
fromTargetId is (TargetModule mod) env dep = do
let fps = [i </> moduleNameSlashes mod -<.> ext | ext <- exts, i <- is ]
exts = ["hs", "hs-boot", "lhs"]
mapM (fmap toNormalizedFilePath' . canonicalizePath) fps
targetToFile _ (TargetFile f _) = do
f' <- canonicalizePath f
return [toNormalizedFilePath' f']
locs <- mapM (fmap toNormalizedFilePath' . canonicalizePath) fps
return [TargetDetails mod env dep locs]
-- For a 'TargetFile' we consider all the possible module names
fromTargetId _ (TargetFile f _) env deps = do
nf <- toNormalizedFilePath' <$> canonicalizePath f
return [TargetDetails m env deps [nf] | m <- moduleNames f]
-- >>> moduleNames "src/A/B.hs"
-- [A.B,B]
moduleNames :: FilePath -> [ModuleName]
moduleNames f = map (mkModuleName .intercalate ".") $ init $ tails nameSegments
where
nameSegments = reverse
$ takeWhile (isUpper . head)
$ reverse
$ splitDirectories
$ dropExtension f
toFlagsMap :: TargetDetails -> [(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))]
toFlagsMap TargetDetails{..} =
[ (l, (targetEnv, targetDepends)) | l <- targetLocations]
setNameCache :: IORef NameCache -> HscEnv -> HscEnv
setNameCache nc hsc = hsc { hsc_NC = nc }
-- | Create a mapping from FilePaths to HscEnvEqs
newComponentCache
:: Logger
-> Bool -- ^ Is this for an implicit/crappy cradle
-> Maybe FilePath -- Path to cradle
-> HscEnv
-> [(InstalledUnitId, DynFlags)]
-> ComponentInfo
-> IO ([(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))], (IdeResult HscEnvEq, DependencyInfo))
newComponentCache logger isImplicit hsc_env uids ci = do
-> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo))
newComponentCache logger cradlePath hsc_env uids ci = do
let df = componentDynFlags ci
let hscEnv' = hsc_env { hsc_dflags = df
, hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
let newFunc = if isImplicit then newHscEnvEqPreserveImportPaths else newHscEnvEq
let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
henv <- newFunc hscEnv' uids
let res = (([], Just henv), componentDependencyInfo ci)
let targetEnv = ([], Just henv)
targetDepends = componentDependencyInfo ci
res = (targetEnv, targetDepends)
logDebug logger ("New Component Cache HscEnvEq: " <> T.pack (show res))
let is = importPaths df
ctargets <- concatMapM (targetToFile is . targetId) (componentTargets ci)
let mk t = fromTargetId (importPaths df) (targetId t) targetEnv targetDepends
ctargets <- concatMapM mk (componentTargets ci)
-- A special target for the file which caused this wonderful
-- component to be created. In case the cradle doesn't list all the targets for
-- the component, in which case things will be horribly broken anyway.
-- Otherwise, we will immediately attempt to reload this module which
-- causes an infinite loop and high CPU usage.
let special_target = (componentFP ci, res)
let xs = map (,res) ctargets
return (special_target:xs, res)
let special_target = TargetDetails (mkModuleName "special") targetEnv targetDepends [componentFP ci]
return (special_target:ctargets, res)
{- Note [Avoiding bad interface files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

16
src/Development/IDE/Core/FileStore.hs
View File

@ -252,15 +252,13 @@ typecheckParents state nfp = void $ shakeEnqueue (shakeExtras state) parents
typecheckParentsAction :: NormalizedFilePath -> Action ()
typecheckParentsAction nfp = do
fs <- useNoFile_ GetKnownFiles
unless (null fs) $ do
revs <- reverseDependencies nfp <$> useNoFile_ GetModuleGraph
logger <- logger <$> getShakeExtras
let log = L.logInfo logger . T.pack
liftIO $ do
(log $ "Typechecking reverse dependencies for" ++ show nfp ++ ": " ++ show revs)
`catch` \(e :: SomeException) -> log (show e)
() <$ uses GetModIface revs
revs <- reverseDependencies nfp <$> useNoFile_ GetModuleGraph
logger <- logger <$> getShakeExtras
let log = L.logInfo logger . T.pack
liftIO $ do
(log $ "Typechecking reverse dependencies for" ++ show nfp ++ ": " ++ show revs)
`catch` \(e :: SomeException) -> log (show e)
() <$ uses GetModIface revs
-- | Note that some buffer somewhere has been modified, but don't say what.
-- Only valid if the virtual file system was initialised by LSP, as that

13
src/Development/IDE/Core/RuleTypes.hs
View File

@ -16,10 +16,10 @@ import Data.Binary
import Development.IDE.Import.DependencyInformation
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import Development.IDE.Core.Shake (KnownTargets)
import Data.Hashable
import Data.Typeable
import qualified Data.Set as S
import qualified Data.HashSet as HS
import Development.Shake
import GHC.Generics (Generic)
@ -29,7 +29,6 @@ import HscTypes (hm_iface, CgGuts, Linkable, HomeModInfo, ModDetails)
import Development.IDE.Spans.Type
import Development.IDE.Import.FindImports (ArtifactsLocation)
import Data.ByteString (ByteString)
import Language.Haskell.LSP.Types (NormalizedFilePath)
-- NOTATION
@ -50,12 +49,12 @@ type instance RuleResult GetDependencies = TransitiveDependencies
type instance RuleResult GetModuleGraph = DependencyInformation
data GetKnownFiles = GetKnownFiles
data GetKnownTargets = GetKnownTargets
deriving (Show, Generic, Eq, Ord)
instance Hashable GetKnownFiles
instance NFData GetKnownFiles
instance Binary GetKnownFiles
type instance RuleResult GetKnownFiles = HS.HashSet NormalizedFilePath
instance Hashable GetKnownTargets
instance NFData GetKnownTargets
instance Binary GetKnownTargets
type instance RuleResult GetKnownTargets = KnownTargets
-- | Contains the typechecked module and the OrigNameCache entry for
-- that module.

22
src/Development/IDE/Core/Rules.hs
View File

@ -90,6 +90,7 @@ import qualified HeaderInfo as Hdr
import Data.Time (UTCTime(..))
import Data.Hashable
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HM
-- | This is useful for rules to convert rules that can only produce errors or
-- a result into the more general IdeResult type that supports producing
@ -322,15 +323,20 @@ getLocatedImportsRule :: Rules ()
getLocatedImportsRule =
define $ \GetLocatedImports file -> do
ms <- use_ GetModSummaryWithoutTimestamps file
targets <- useNoFile_ GetKnownFiles
targets <- useNoFile_ GetKnownTargets
let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]
env_eq <- use_ GhcSession file
let env = hscEnvWithImportPaths env_eq
let import_dirs = deps env_eq
let dflags = addRelativeImport file (moduleName $ ms_mod ms) $ hsc_dflags env
let dflags = hsc_dflags env
isImplicitCradle = isNothing $ envImportPaths env_eq
dflags <- return $ if isImplicitCradle
then addRelativeImport file (moduleName $ ms_mod ms) dflags
else dflags
opt <- getIdeOptions
let getTargetExists nfp
| HashSet.null targets || nfp `HashSet.member` targets = getFileExists nfp
let getTargetExists modName nfp
| isImplicitCradle = getFileExists nfp
| HM.member modName targets = getFileExists nfp
| otherwise = return False
(diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource
@ -532,14 +538,14 @@ typeCheckRule = define $ \TypeCheck file -> do
typeCheckRuleDefinition hsc pm isFoi (Just source)
knownFilesRule :: Rules ()
knownFilesRule = defineEarlyCutOffNoFile $ \GetKnownFiles -> do
knownFilesRule = defineEarlyCutOffNoFile $ \GetKnownTargets -> do
alwaysRerun
fs <- knownFiles
fs <- knownTargets
pure (BS.pack (show $ hash fs), unhashed fs)
getModuleGraphRule :: Rules ()
getModuleGraphRule = defineNoFile $ \GetModuleGraph -> do
fs <- useNoFile_ GetKnownFiles
fs <- toKnownFiles <$> useNoFile_ GetKnownTargets
rawDepInfo <- rawDependencyInformation (HashSet.toList fs)
pure $ processDependencyInformation rawDepInfo
@ -683,7 +689,7 @@ ghcSessionDepsDefinition file = do
setupFinderCache (map hirModSummary ifaces)
mapM_ (uncurry loadDepModule) inLoadOrder
res <- liftIO $ newHscEnvEq session' []
res <- liftIO $ newHscEnvEq "" session' []
return ([], Just res)
where
unpack HiFileResult{..} bc = (hirModIface, bc)

31
src/Development/IDE/Core/Shake.hs
View File

@ -24,6 +24,7 @@
module Development.IDE.Core.Shake(
IdeState, shakeExtras,
ShakeExtras(..), getShakeExtras, getShakeExtrasRules,
KnownTargets, toKnownFiles,
IdeRule, IdeResult,
GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),
shakeOpen, shakeShut,
@ -44,7 +45,7 @@ module Development.IDE.Core.Shake(
getIdeOptionsIO,
GlobalIdeOptions(..),
garbageCollect,
knownFiles,
knownTargets,
setPriority,
sendEvent,
ideLogger,
@ -67,20 +68,22 @@ import Development.Shake hiding (ShakeValue, doesFileExist, Info)
import Development.Shake.Database
import Development.Shake.Classes
import Development.Shake.Rule
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMap
import qualified Data.HashSet as HSet
import qualified Data.Map.Strict as Map
import qualified Data.ByteString.Char8 as BS
import Data.Dynamic
import Data.Maybe
import Data.Map.Strict (Map)
import Data.Map.Strict (Map)
import Data.List.Extra (partition, takeEnd)
import Data.HashSet (HashSet)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Tuple.Extra
import Data.Unique
import Development.IDE.Core.Debouncer
import Development.IDE.GHC.Compat ( NameCacheUpdater(..), upNameCache )
import Development.IDE.GHC.Compat (ModuleName, NameCacheUpdater(..), upNameCache )
import Development.IDE.GHC.Orphans ()
import Development.IDE.Core.PositionMapping
import Development.IDE.Types.Action
import Development.IDE.Types.Logger hiding (Priority)
@ -120,6 +123,7 @@ import NameCache
import UniqSupply
import PrelInfo
import Data.Int (Int64)
import qualified Data.HashSet as HSet
-- information we stash inside the shakeExtra field
data ShakeExtras = ShakeExtras
@ -152,13 +156,20 @@ data ShakeExtras = ShakeExtras
-- ^ Same as 'withProgress', but for processes that do not report the percentage complete
,restartShakeSession :: [DelayedAction ()] -> IO ()
,ideNc :: IORef NameCache
,knownFilesVar :: Var (Hashed (HSet.HashSet NormalizedFilePath))
-- | A mapping of module name to known target (or candidate targets, if missing)
,knownTargetsVar :: Var (Hashed KnownTargets)
-- | A mapping of exported identifiers for local modules. Updated on kick
,exportsMap :: Var ExportsMap
-- | A work queue for actions added via 'runInShakeSession'
,actionQueue :: ActionQueue
}
-- | A mapping of module name to known files
type KnownTargets = HashMap ModuleName [NormalizedFilePath]
toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath
toKnownFiles = HSet.fromList . concat . HMap.elems
type WithProgressFunc = forall a.
T.Text -> LSP.ProgressCancellable -> ((LSP.Progress -> IO ()) -> IO a) -> IO a
type WithIndefiniteProgressFunc = forall a.
@ -365,10 +376,10 @@ getValues state key file = do
evaluate (r `seqValue` Just r)
-- | Get all the files in the project
knownFiles :: Action (Hashed (HSet.HashSet NormalizedFilePath))
knownFiles = do
ShakeExtras{knownFilesVar} <- getShakeExtras
liftIO $ readVar knownFilesVar
knownTargets :: Action (Hashed KnownTargets)
knownTargets = do
ShakeExtras{knownTargetsVar} <- getShakeExtras
liftIO $ readVar knownTargetsVar
-- | Seq the result stored in the Shake value. This only
-- evaluates the value to WHNF not NF. We take care of the latter
@ -405,7 +416,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
hiddenDiagnostics <- newVar mempty
publishedDiagnostics <- newVar mempty
positionMapping <- newVar HMap.empty
knownFilesVar <- newVar $ hashed HSet.empty
knownTargetsVar <- newVar $ hashed HMap.empty
let restartShakeSession = shakeRestart ideState
let session = shakeSession
mostRecentProgressEvent <- newTVarIO KickCompleted

5
src/Development/IDE/GHC/Orphans.hs
View File

@ -75,3 +75,8 @@ deriving instance Eq SourceModified
deriving instance Show SourceModified
instance NFData SourceModified where
rnf = rwhnf
instance Show ModuleName where
show = moduleNameString
instance Hashable ModuleName where
hashWithSalt salt = hashWithSalt salt . show

8
src/Development/IDE/GHC/Util.hs
View File

@ -7,6 +7,7 @@ module Development.IDE.GHC.Util(
HscEnvEq,
hscEnv, newHscEnvEq,
hscEnvWithImportPaths,
envImportPaths,
modifyDynFlags,
evalGhcEnv,
runGhcEnv,
@ -184,10 +185,11 @@ data HscEnvEq = HscEnvEq
}
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
newHscEnvEq :: HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEq hscEnv0 deps = do
newHscEnvEq :: FilePath -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEq cradlePath hscEnv0 deps = do
envUnique <- newUnique
let envImportPaths = Just $ importPaths $ hsc_dflags hscEnv0
let envImportPaths = Just $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0)
relativeToCradle = (takeDirectory cradlePath </>)
hscEnv = removeImportPaths hscEnv0
return HscEnvEq{..}

16
src/Development/IDE/Import/FindImports.hs
View File

@ -66,7 +66,7 @@ modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location ms) (i
locateModuleFile :: MonadIO m
=> [[FilePath]]
-> [String]
-> (NormalizedFilePath -> m Bool)
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Bool
-> ModuleName
-> m (Maybe NormalizedFilePath)
@ -74,7 +74,7 @@ locateModuleFile import_dirss exts doesExist isSource modName = do
let candidates import_dirs =
[ toNormalizedFilePath' (prefix </> M.moduleNameSlashes modName <.> maybeBoot ext)
| prefix <- import_dirs , ext <- exts]
findM doesExist (concatMap candidates import_dirss)
findM (doesExist modName) (concatMap candidates import_dirss)
where
maybeBoot ext
| isSource = ext ++ "-boot"
@ -92,12 +92,12 @@ mkImportDirs df (i, DynFlags{importPaths}) = (, importPaths) <$> getPackageName
locateModule
:: MonadIO m
=> DynFlags
-> [(M.InstalledUnitId, DynFlags)] -- Sets import directories to look in
-> [String]
-> (NormalizedFilePath -> m Bool)
-> Located ModuleName
-> Maybe FastString
-> Bool
-> [(M.InstalledUnitId, DynFlags)] -- ^ Import directories
-> [String] -- ^ File extensions
-> (ModuleName -> NormalizedFilePath -> m Bool) -- ^ does file exist predicate
-> Located ModuleName -- ^ Moudle name
-> Maybe FastString -- ^ Package name
-> Bool -- ^ Is boot module
-> m (Either [FileDiagnostic] Import)
locateModule dflags comp_info exts doesExist modName mbPkgName isSource = do
case mbPkgName of

34
test/exe/Main.hs
View File

@ -533,7 +533,7 @@ codeLensesTests = testGroup "code lenses"
watchedFilesTests :: TestTree
watchedFilesTests = testGroup "watched files"
[ testSession' "workspace files" $ \sessionDir -> do
liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\"]}}"
liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\", \"A\", \"WatchedFilesMissingModule\"]}}"
_doc <- createDoc "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule"
watchedFileRegs <- getWatchedFilesSubscriptionsUntil @PublishDiagnosticsNotification
@ -546,7 +546,7 @@ watchedFilesTests = testGroup "watched files"
liftIO $ length watchedFileRegs @?= 5
, testSession' "non workspace file" $ \sessionDir -> do
liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-i/tmp\"]}}"
liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-i/tmp\", \"A\", \"WatchedFilesMissingModule\"]}}"
_doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule"
watchedFileRegs <- getWatchedFilesSubscriptionsUntil @PublishDiagnosticsNotification
@ -2917,11 +2917,11 @@ simpleMultiTest2 = testCase "simple-multi-test2" $ withoutStackEnv $ runWithExtr
bPath = dir </> "b/B.hs"
bSource <- liftIO $ readFileUtf8 bPath
bdoc <- createDoc bPath "haskell" bSource
expectNoMoreDiagnostics 5
expectNoMoreDiagnostics 10
aSource <- liftIO $ readFileUtf8 aPath
(TextDocumentIdentifier adoc) <- createDoc aPath "haskell" aSource
-- Need to have some delay here or the test fails
expectNoMoreDiagnostics 6
expectNoMoreDiagnostics 10
locs <- getDefinitions bdoc (Position 2 7)
let fooL = mkL adoc 2 0 2 3
checkDefs locs (pure [fooL])
@ -2931,7 +2931,8 @@ ifaceTests :: TestTree
ifaceTests = testGroup "Interface loading tests"
[ -- https://github.com/digital-asset/ghcide/pull/645/
ifaceErrorTest
, ifaceErrorTest2
-- https://github.com/haskell/ghcide/pull/781
, ignoreTestBecause "too flaky" ifaceErrorTest2
, ifaceErrorTest3
, ifaceTHTest
]
@ -3056,6 +3057,10 @@ ifaceErrorTest2 = testCase "iface-error-test-2" $ withoutStackEnv $ runWithExtra
,("P.hs", [(DsWarning,(4,0), "Top-level binding")])
,("P.hs", [(DsWarning,(6,0), "Top-level binding")])
]
-- FLAKY: 1 out of 5 times in CI ghcide does not send any diagnostics back,
-- not even for P, which makes the expectDiagnostics above to time out
-- cannot repro locally even after wiping the interface cache dir
expectNoMoreDiagnostics 2
ifaceErrorTest3 :: TestTree
@ -3267,19 +3272,24 @@ runInDir' dir startExeIn startSessionIn s = do
-- since the package import test creates "Data/List.hs", which otherwise has no physical home
createDirectoryIfMissing True $ projDir ++ "/Data"
let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", startDir]
let cmd = unwords [ghcideExe, "--lsp", "--test", "--verbose", "--cwd", startDir]
-- HIE calls getXgdDirectory which assumes that HOME is set.
-- Only sets HOME if it wasn't already set.
setEnv "HOME" "/homeless-shelter" False
let lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True }
runSessionWithConfig conf cmd lspTestCaps projDir s
logColor <- fromMaybe True <$> checkEnv "LSP_TEST_LOG_COLOR"
runSessionWithConfig conf{logColor} cmd lspTestCaps projDir s
where
checkEnv :: String -> IO (Maybe Bool)
checkEnv s = fmap convertVal <$> getEnv s
convertVal "0" = False
convertVal _ = True
conf = defaultConfig
-- If you uncomment this you can see all logging
-- which can be quite useful for debugging.
-- { logStdErr = True, logColor = False }
-- If you really want to, you can also see all messages
-- { logMessages = True, logColor = False }
-- uncomment this or set LSP_TEST_LOG_STDERR=1 to see all logging
-- { logStdErr = True }
-- uncomment this or set LSP_TEST_LOG_MESSAGES=1 to see all messages
-- { logMessages = True }
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
openTestDataDoc path = do