From e1f14bf6ad41d3cb2d5d2d59351e914e6e7acd7c Mon Sep 17 00:00:00 2001
From: Michael Sloan <mgsloan@gmail.com>
Date: Sun, 15 May 2016 06:04:55 -0700
Subject: [PATCH] Fix parsing of relative qAddDependentFile paths #1982

---
 ChangeLog.md         |  5 ++++-
 src/Stack/Package.hs | 22 +++++++++++-----------
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index d886bbed41..1aa899e2d0 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -40,7 +40,7 @@ Other enhancements:
 Bug fixes:
 
 * Now ignore project config when doing `stack init` or `stack new`. See
-  [#2110](https://github.com/commercialhaskell/stack/issues/2110).
+  [#2110](https://github.com/commercialhaskell/stack/issues/2110)
 * Packages specified by git repo can now have submodules. See
   [#2133](https://github.com/commercialhaskell/stack/issues/2133)
 * Fix of hackage index fetch retry. See re-opening of
@@ -55,6 +55,9 @@ Bug fixes:
   [#1841](https://github.com/commercialhaskell/stack/issues/1841)
 * `stack ghci` now uses `extra-lib-dirs` and `extra-include-dirs`. See
   [#1656](https://github.com/commercialhaskell/stack/issues/1656)
+* Relative paths outside of source dir added via `qAddDependentFile` are now
+  checked for dirtiness. See
+  [#1982](https://github.com/commercialhaskell/stack/issues/1982)
 
 ## 1.1.0
 
diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
index b38282b039..5736b7b31e 100644
--- a/src/Stack/Package.hs
+++ b/src/Stack/Package.hs
@@ -855,7 +855,7 @@ depRange (Dependency _ r) = r
 -- extensions, plus find any of their module and TemplateHaskell
 -- dependencies.
 resolveFilesAndDeps
-    :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
+    :: (MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m, MonadReader (Path Abs File, Path Abs Dir) m)
     => Maybe String         -- ^ Package component name
     -> [Path Abs Dir]       -- ^ Directories to look in.
     -> [DotCabalDescriptor] -- ^ Base names.
@@ -922,7 +922,7 @@ resolveFilesAndDeps component dirs names0 exts = do
 
 -- | Get the dependencies of a Haskell module file.
 getDependencies
-    :: (MonadReader (Path Abs File, Path Abs Dir) m, MonadIO m)
+    :: (MonadReader (Path Abs File, Path Abs Dir) m, MonadIO m, MonadCatch m, MonadLogger m)
     => Maybe String -> DotCabalPath -> m (Set ModuleName, [Path Abs File])
 getDependencies component dotCabalPath =
     case dotCabalPath of
@@ -951,7 +951,7 @@ getDependencies component dotCabalPath =
 
 -- | Parse a .dump-hi file into a set of modules and files.
 parseDumpHI
-    :: (MonadReader (Path Abs File, void) m, MonadIO m)
+    :: (MonadReader (Path Abs File, void) m, MonadIO m, MonadCatch m, MonadLogger m)
     => FilePath -> m (Set ModuleName, [Path Abs File])
 parseDumpHI dumpHIPath = do
     dir <- asks (parent . fst)
@@ -969,17 +969,17 @@ parseDumpHI dumpHIPath = do
             -- The dependent file path is surrounded by quotes but is not escaped.
             -- It can be an absolute or relative path.
             mapMaybe
-                (parseAbsOrRelFile dir <=<
-                 (fmap T.unpack .
+                ((fmap T.unpack .
                   (T.stripSuffix "\"" <=< T.stripPrefix "\"") .
                   T.dropWhileEnd (== '\r') . decodeUtf8 . C8.dropWhile (/= '"'))) $
             filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI
-    return (moduleDeps, thDeps)
-  where
-    parseAbsOrRelFile dir fp =
-        case parseRelFile fp of
-            Just rel -> Just (dir </> rel)
-            Nothing -> parseAbsFile fp
+    thDepsResolved <- liftM catMaybes $ forM thDeps $ \x -> do
+        mresolved <- forgivingAbsence (resolveFile dir x) >>= rejectMissingFile
+        when (isNothing mresolved) $
+            $logWarn $ "Warning: qAddDepedency path listed in " <> T.pack dumpHIPath <>
+                " does not exist: " <> T.pack x
+        return mresolved
+    return (moduleDeps, thDepsResolved)
 
 -- | Try to resolve the list of base names in the given directory by
 -- looking for unique instances of base names applied with the given