From 6069de432c38fb8b67d8b1968a6b3bde14232e40 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 13 Aug 2018 08:15:59 +0300
Subject: [PATCH] Handle hash at the end of addDependentFile

Fixes yesodweb/yesod#1551
---
 ChangeLog.md                                   |  4 ++++
 src/Stack/Package.hs                           | 12 +++++++-----
 test/integration/lib/StackTest.hs              | 18 ++++++++++++++++++
 test/integration/tests/watched-files/Main.hs   | 14 ++++++++++++++
 .../tests/watched-files/files/.gitignore       |  2 ++
 .../tests/watched-files/files/Main.hs          |  9 +++++++++
 .../tests/watched-files/files/package.yaml     |  9 +++++++++
 .../tests/watched-files/files/stack.yaml       |  1 +
 8 files changed, 64 insertions(+), 5 deletions(-)
 create mode 100644 test/integration/tests/watched-files/Main.hs
 create mode 100644 test/integration/tests/watched-files/files/.gitignore
 create mode 100644 test/integration/tests/watched-files/files/Main.hs
 create mode 100644 test/integration/tests/watched-files/files/package.yaml
 create mode 100644 test/integration/tests/watched-files/files/stack.yaml

diff --git a/ChangeLog.md b/ChangeLog.md
index fd2db58bc1..01674a0891 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -18,6 +18,10 @@ Other enhancements:
 
 Bug fixes:
 
+* Handle a change in GHC's hi-dump format around `addDependentFile`,
+  which now includes a hash. See
+  [yesodweb/yesod#1551](https://github.com/yesodweb/yesod/issues/1551)
+
 
 ## v1.9.0 (release candidate)
 
diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
index ff7e35cb52..853fb43441 100644
--- a/src/Stack/Package.hs
+++ b/src/Stack/Package.hs
@@ -1284,11 +1284,13 @@ parseDumpHI dumpHIPath = do
         thDeps =
             -- The dependent file path is surrounded by quotes but is not escaped.
             -- It can be an absolute or relative path.
-            mapMaybe
-                (fmap TL.unpack .
-                  (TL.stripSuffix "\"" <=< TL.stripPrefix "\"") .
-                  TL.dropWhileEnd (== '\r') . TLE.decodeUtf8 . CL8.dropWhile (/= '"')) $
-            filter ("addDependentFile \"" `CL8.isPrefixOf`) dumpHI
+                ( TL.unpack .
+                  -- Starting with GHC 8.4.3, there's a hash following
+                  -- the path. See
+                  -- https://github.com/yesodweb/yesod/issues/1551
+                  TLE.decodeUtf8 .
+                  CL8.takeWhile (/= '\"')) <$>
+            mapMaybe (CL8.stripPrefix "addDependentFile \"") dumpHI
     thDepsResolved <- liftM catMaybes $ forM thDeps $ \x -> do
         mresolved <- liftIO (forgivingAbsence (resolveFile dir x)) >>= rejectMissingFile
         when (isNothing mresolved) $
diff --git a/test/integration/lib/StackTest.hs b/test/integration/lib/StackTest.hs
index c450dd46dc..9cd9e01489 100644
--- a/test/integration/lib/StackTest.hs
+++ b/test/integration/lib/StackTest.hs
@@ -126,6 +126,24 @@ stackErrStderr args check = do
         then error "Stack process succeeded, but it shouldn't"
         else check err
 
+stackStdout :: [String] -> IO (ExitCode, String)
+stackStdout args = do
+    stackExe' <- stackExe
+    logInfo $ "Running: " ++ stackExe' ++ " " ++ unwords (map showProcessArgDebug args)
+    (ec, out, err) <- readProcessWithExitCode stackExe' args ""
+    putStr out
+    hPutStr stderr err
+    return (ec, out)
+
+-- | Run stack with arguments and apply a check to the resulting
+-- stdout output if the process succeeded.
+stackCheckStdout :: [String] -> (String -> IO ()) -> IO ()
+stackCheckStdout args check = do
+    (ec, out) <- stackStdout args
+    if ec /= ExitSuccess
+        then error $ "Exited with exit code: " ++ show ec
+        else check out
+
 doesNotExist :: FilePath -> IO ()
 doesNotExist fp = do
     logInfo $ "doesNotExist " ++ fp
diff --git a/test/integration/tests/watched-files/Main.hs b/test/integration/tests/watched-files/Main.hs
new file mode 100644
index 0000000000..d683c93a0b
--- /dev/null
+++ b/test/integration/tests/watched-files/Main.hs
@@ -0,0 +1,14 @@
+import StackTest
+import Data.Foldable (for_)
+import Control.Monad (unless)
+
+main :: IO ()
+main = for_ (words "foo bar baz bin") $ \x -> do
+  writeFile "some-text-file.txt" x
+  stackCheckStdout ["run"] $ \y ->
+    unless (x == y) $ error $ concat
+      [ "Expected: "
+      , show x
+      , "\nActual:  "
+      , show y
+      ]
diff --git a/test/integration/tests/watched-files/files/.gitignore b/test/integration/tests/watched-files/files/.gitignore
new file mode 100644
index 0000000000..d09ee0af48
--- /dev/null
+++ b/test/integration/tests/watched-files/files/.gitignore
@@ -0,0 +1,2 @@
+some-text-file.txt
+*.cabal
diff --git a/test/integration/tests/watched-files/files/Main.hs b/test/integration/tests/watched-files/files/Main.hs
new file mode 100644
index 0000000000..a462eafd73
--- /dev/null
+++ b/test/integration/tests/watched-files/files/Main.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Data.FileEmbed
+import qualified Data.ByteString as B
+import System.IO (stdout)
+
+main :: IO ()
+main = B.hPut stdout $(embedFile "some-text-file.txt")
diff --git a/test/integration/tests/watched-files/files/package.yaml b/test/integration/tests/watched-files/files/package.yaml
new file mode 100644
index 0000000000..6611f13029
--- /dev/null
+++ b/test/integration/tests/watched-files/files/package.yaml
@@ -0,0 +1,9 @@
+name: watched-files
+dependencies:
+- base
+- bytestring
+- file-embed
+
+executables:
+  watched:
+    main: Main.hs
diff --git a/test/integration/tests/watched-files/files/stack.yaml b/test/integration/tests/watched-files/files/stack.yaml
new file mode 100644
index 0000000000..9673b65de3
--- /dev/null
+++ b/test/integration/tests/watched-files/files/stack.yaml
@@ -0,0 +1 @@
+resolver: lts-11.19