Skip to content

Commit

Permalink
Fix parsing of relative qAddDependentFile paths #1982
Browse files Browse the repository at this point in the history
  • Loading branch information
mgsloan committed May 15, 2016
1 parent 7954709 commit e1f14bf
Show file tree
Hide file tree
Showing 2 changed files with 15 additions and 12 deletions.
5 changes: 4 additions & 1 deletion ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand Down
22 changes: 11 additions & 11 deletions src/Stack/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down

0 comments on commit e1f14bf

Please sign in to comment.