diff --git a/ChangeLog.md b/ChangeLog.md index ad58cf70fa..fef5c5da00 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -97,6 +97,11 @@ Bug fixes: [#4314](https://github.com/commercialhaskell/stack/pull/4314) * Add `--cabal-files` flag to `stack ide targets` command. * Don't download ghc when using `stack clean`. +* Support loading in GHCi definitions from symlinked C files. Without this + patch, Stack will try to find object files in the directory pointed to + by symlinks, while GCC will produce the object files in the original + directory. See + [#4402](https://github.com/commercialhaskell/stack/pull/4402) ## v1.9.1 diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index b7ad44820a..542ed97f4d 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -803,12 +803,21 @@ resolveComponentFiles component build names = do -- | Get all C sources and extra source files in a build. buildOtherSources :: BuildInfo -> RIO Ctx [DotCabalPath] -buildOtherSources build = - do csources <- liftM (map DotCabalCFilePath) - (mapMaybeM resolveFileOrWarn (cSources build)) - jsources <- liftM (map DotCabalFilePath) - (mapMaybeM resolveFileOrWarn (targetJsSources build)) - return (csources <> jsources) +buildOtherSources build = do + cwd <- liftIO getCurrentDir + dir <- asks (parent . ctxFile) + file <- asks ctxFile + let resolveDirFiles files toCabalPath = + forMaybeM files $ \fp -> do + result <- resolveDirFile dir fp + case result of + Nothing -> do + warnMissingFile "File" cwd fp file + return Nothing + Just p -> return $ Just (toCabalPath p) + csources <- resolveDirFiles (cSources build) DotCabalCFilePath + jsources <- resolveDirFiles (targetJsSources build) DotCabalFilePath + return (csources <> jsources) -- | Get the target's JS sources. targetJsSources :: BuildInfo -> [FilePath] @@ -1227,14 +1236,18 @@ findCandidate dirs name = do -- Otherwise, return everything (xs, ys) -> xs ++ ys - resolveCandidate - :: (MonadIO m, MonadThrow m) - => Path Abs Dir -> FilePath.FilePath -> m [Path Abs File] - resolveCandidate x y = do - -- The standard canonicalizePath does not work for this case - p <- parseCollapsedAbsFile (toFilePath x FilePath. y) - exists <- doesFileExist p - return $ if exists then [p] else [] + resolveCandidate dir = fmap maybeToList . resolveDirFile dir + +-- | Resolve file as a child of a specified directory, symlinks +-- don't get followed. +resolveDirFile + :: (MonadIO m, MonadThrow m) + => Path Abs Dir -> FilePath.FilePath -> m (Maybe (Path Abs File)) +resolveDirFile x y = do + -- The standard canonicalizePath does not work for this case + p <- parseCollapsedAbsFile (toFilePath x FilePath. y) + exists <- doesFileExist p + return $ if exists then Just p else Nothing -- | Warn the user that multiple candidates are available for an -- entry, but that we picked one anyway and continued. @@ -1311,16 +1324,19 @@ resolveOrWarn subject resolver path = file <- asks ctxFile dir <- asks (parent . ctxFile) result <- resolver dir path - when (isNothing result) $ - prettyWarnL - [ fromString . T.unpack $ subject -- TODO: needs style? - , flow "listed in" - , maybe (pretty file) pretty (stripProperPrefix cwd file) - , flow "file does not exist:" - , style Dir . fromString $ path - ] + when (isNothing result) $ warnMissingFile subject cwd path file return result +warnMissingFile :: Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx () +warnMissingFile subject cwd path fromFile = + prettyWarnL + [ fromString . T.unpack $ subject -- TODO: needs style? + , flow "listed in" + , maybe (pretty fromFile) pretty (stripProperPrefix cwd fromFile) + , flow "file does not exist:" + , style Dir . fromString $ path + ] + -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). resolveFileOrWarn :: FilePath.FilePath diff --git a/test/integration/IntegrationSpec.hs b/test/integration/IntegrationSpec.hs index f5595e5eb8..1144347dad 100644 --- a/test/integration/IntegrationSpec.hs +++ b/test/integration/IntegrationSpec.hs @@ -139,6 +139,7 @@ toCopyRoot srcfp = any (`isSuffixOf` srcfp) -- FIXME command line parameters to control how many of these get -- copied, trade-off of runtime/bandwidth vs isolation of tests [ ".tar" + , ".tar.gz" , ".xz" -- , ".gz" , ".7z.exe" diff --git a/test/integration/lib/StackTest.hs b/test/integration/lib/StackTest.hs index 12daa8e280..1cd7bca05a 100644 --- a/test/integration/lib/StackTest.hs +++ b/test/integration/lib/StackTest.hs @@ -98,8 +98,10 @@ runRepl cmd args actions = do hSetBuffering rStderr NoBuffering _ <- forkIO $ withFile "/tmp/stderr" WriteMode - $ \err -> forever $ catch (hGetChar rStderr >>= hPutChar err) - $ \e -> unless (isEOFError e) $ throw e + $ \err -> do + hSetBuffering err NoBuffering + forever $ catch (hGetChar rStderr >>= hPutChar err) + $ \e -> unless (isEOFError e) $ throw e runReaderT (nextPrompt >> actions) (ReplConnection rStdin rStdout) waitForProcess ph diff --git a/test/integration/tests/4270-files-order/files/stack.yaml b/test/integration/tests/4270-files-order/files/stack.yaml index c18657e207..2241b0f190 100644 --- a/test/integration/tests/4270-files-order/files/stack.yaml +++ b/test/integration/tests/4270-files-order/files/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-12.8 +resolver: lts-11.22 packages: - .