for 'stack ghci', don't throw away hsSourceDirs that have '..' in them. commercialhaskell#2895

tallen-imvu · tallen-imvu · commit 49500a12028c · 2017-01-12T17:17:52.000-08:00
diff --git a/src/Path/Extra.hs b/src/Path/Extra.hs
@@ -7,6 +7,7 @@ module Path.Extra
   ,dropRoot
   ,parseCollapsedAbsDir
   ,parseCollapsedAbsFile
+  ,concatAndColapseAbsDir
   ,rejectMissingFile
   ,rejectMissingDir
   ,pathToByteString
@@ -43,6 +44,12 @@ parseCollapsedAbsDir = parseAbsDir . collapseFilePath
 parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
 parseCollapsedAbsFile = parseAbsFile . collapseFilePath
 
+-- | Combine a 'Path Abs Dir' and a relative 'FilePath' into a 'Path Abs Dir'
+-- We can't parse the FilePath first because we need to account for ".."
+-- in the FilePath (#2895)
+concatAndColapseAbsDir :: MonadThrow m => Path Abs Dir -> FilePath -> m (Path Abs Dir)
+concatAndColapseAbsDir base rel = parseCollapsedAbsDir (toFilePath base FP.</> rel)
+
 -- | Collapse intermediate "." and ".." directories from a path.
 --
 -- > collapseFilePath "./foo" == "foo"
diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
@@ -420,7 +420,7 @@ generateBuildInfoOpts BioInput {..} =
              | Just makeGenDir <- [fileGenDirFromComponentName biComponentName]]) ++
         ["-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir)]
     toIncludeDir "." = Just biCabalDir
-    toIncludeDir x = fmap (biCabalDir </>) (parseRelDir x)
+    toIncludeDir relDir = concatAndColapseAbsDir biCabalDir relDir
     includeOpts =
         map ("-I" <>) (configExtraIncludeDirs <> pkgIncludeOpts)
     configExtraIncludeDirs =
