Skip to content

Commit

Permalink
Now ghci only loads present modules #1805
Browse files Browse the repository at this point in the history
+ Fully resolves #921, where unlisted module warnings were being emitted
for deleted modules
  • Loading branch information
mgsloan committed Feb 21, 2016
1 parent ebe4305 commit c0ccf35
Show file tree
Hide file tree
Showing 2 changed files with 55 additions and 16 deletions.
50 changes: 34 additions & 16 deletions src/Stack/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -838,32 +838,41 @@ resolveFilesAndDeps
=> Maybe String -- ^ Package component name
-> [Path Abs Dir] -- ^ Directories to look in.
-> [DotCabalDescriptor] -- ^ Base names.
-> [Text] -- ^ Extentions.
-> [Text] -- ^ Extensions.
-> m (Set ModuleName,Set DotCabalPath,[PackageWarning])
resolveFilesAndDeps component dirs names0 exts = do
(dotCabalPaths,foundModules) <- loop names0 S.empty
warnings <- warnUnlisted foundModules
(dotCabalPaths, foundModules, missingModules) <- loop names0 S.empty
warnings <- (++) <$> warnUnlisted foundModules <*> warnMissing missingModules
return (foundModules, dotCabalPaths, warnings)
where
loop [] doneModules = return (S.empty, doneModules)
loop [] _ = return (S.empty, S.empty, [])
loop names doneModules0 = do
resolvedFiles <- resolveFiles dirs names exts
pairs <- mapM (getDependencies component) resolvedFiles
let doneModules' =
resolved <- resolveFiles dirs names exts
let foundFiles = mapMaybe snd resolved
(foundModules', missingModules') = partition (isJust . snd) resolved
foundModules = mapMaybe (dotCabalModule . fst) foundModules'
missingModules = mapMaybe (dotCabalModule . fst) missingModules'
pairs <- mapM (getDependencies component) foundFiles
let doneModules =
S.union
doneModules0
(S.fromList (mapMaybe dotCabalModule names))
moduleDeps = S.unions (map fst pairs)
thDepFiles = concatMap snd pairs
modulesRemaining = S.difference moduleDeps doneModules'
(resolvedFiles',doneModules'') <-
loop (map DotCabalModule (S.toList modulesRemaining)) doneModules'
modulesRemaining = S.difference moduleDeps doneModules
-- Ignore missing modules discovered as dependencies - they may
-- have been deleted.
(resolvedFiles, resolvedModules, _) <-
loop (map DotCabalModule (S.toList modulesRemaining)) doneModules
return
( S.union
(S.fromList
(resolvedFiles <> map DotCabalFilePath thDepFiles))
resolvedFiles'
, doneModules'')
(foundFiles <> map DotCabalFilePath thDepFiles))
resolvedFiles
, S.union
(S.fromList foundModules)
resolvedModules
, missingModules)
warnUnlisted foundModules = do
let unlistedModules =
foundModules `S.difference`
Expand All @@ -876,6 +885,15 @@ resolveFilesAndDeps component dirs names0 exts = do
cabalfp
component
(S.toList unlistedModules)]
warnMissing missingModules = do
cabalfp <- asks fst
return $
if null missingModules
then []
else [ MissingModulesWarning
cabalfp
component
missingModules]

-- | Get the dependencies of a Haskell module file.
getDependencies
Expand Down Expand Up @@ -945,10 +963,10 @@ resolveFiles
:: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
=> [Path Abs Dir] -- ^ Directories to look in.
-> [DotCabalDescriptor] -- ^ Base names.
-> [Text] -- ^ Extentions.
-> m [DotCabalPath]
-> [Text] -- ^ Extensions.
-> m [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles dirs names exts =
forMaybeM names (findCandidate dirs exts)
forM names (\name -> (name, ) <$> findCandidate dirs exts name)

-- | Find a candidate for the given module-or-filename from the list
-- of directories and given extensions.
Expand Down
21 changes: 21 additions & 0 deletions src/Stack/Types/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -151,6 +151,8 @@ instance Show GetPackageFiles where
data PackageWarning
= UnlistedModulesWarning (Path Abs File) (Maybe String) [ModuleName]
-- ^ Modules found that are not listed in cabal file
| MissingModulesWarning (Path Abs File) (Maybe String) [ModuleName]
-- ^ Modules not found in file system, which are listed in cabal file
instance Show PackageWarning where
show (UnlistedModulesWarning cabalfp component [unlistedModule]) =
concat
Expand All @@ -170,6 +172,25 @@ instance Show PackageWarning where
Just c -> " for '" ++ c ++ "'"
, " component (add to other-modules):\n "
, intercalate "\n " (map display unlistedModules)]
show (MissingModulesWarning cabalfp component [missingModule]) =
concat
[ "module listed in "
, toFilePath (filename cabalfp)
, case component of
Nothing -> " for library"
Just c -> " for '" ++ c ++ "'"
, " component not found in filesystem: "
, display missingModule]
show (MissingModulesWarning cabalfp component missingModules) =
concat
[ "modules listed in "
, toFilePath (filename cabalfp)
, case component of
Nothing -> " for library"
Just c -> " for '" ++ c ++ "'"
, " component not found in filesystem:\n "
, intercalate "\n " (map display missingModules)]


-- | Package build configuration
data PackageConfig =
Expand Down

0 comments on commit c0ccf35

Please sign in to comment.