From c0ccf355013c5f4c3d62ec7da71971cf6a5430dc Mon Sep 17 00:00:00 2001
From: Michael Sloan <mgsloan@gmail.com>
Date: Sun, 21 Feb 2016 13:37:40 -0800
Subject: [PATCH] Now ghci only loads present modules #1805

+ Fully resolves #921, where unlisted module warnings were being emitted
for deleted modules
---
 src/Stack/Package.hs       | 50 ++++++++++++++++++++++++++------------
 src/Stack/Types/Package.hs | 21 ++++++++++++++++
 2 files changed, 55 insertions(+), 16 deletions(-)

diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
index d40aad4130..de1471f0ed 100644
--- a/src/Stack/Package.hs
+++ b/src/Stack/Package.hs
@@ -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`
@@ -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
@@ -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.
diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs
index f8696f8b7f..6789599bfb 100644
--- a/src/Stack/Types/Package.hs
+++ b/src/Stack/Types/Package.hs
@@ -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
@@ -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 =