diff --git a/ChangeLog.md b/ChangeLog.md index 1106b66441..982ed59217 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -26,6 +26,8 @@ Bug fixes: See [rio#237](https://github.com/commercialhaskell/rio/pull/237) * Fix handling of overwritten `ghc` and `ghc-pkg` locations. [#5597](https://github.com/commercialhaskell/stack/pull/5597) +* Fix failure to find package when a dependency is shared between projects. + [#5680](https://github.com/commercialhaskell/stack/issues/5680) ## v2.7.3 diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs index 1d0120f189..22affd42de 100644 --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -12,6 +12,7 @@ module Stack.Build.Cache , tryGetConfigCache , tryGetCabalMod , tryGetSetupConfigMod + , tryGetPackageProjectRoot , getInstalledExes , tryGetFlagCache , deleteCaches @@ -22,6 +23,7 @@ module Stack.Build.Cache , writeConfigCache , writeCabalMod , writeSetupConfigMod + , writePackageProjectRoot , TestStatus (..) , setTestStatus , getTestStatus @@ -34,6 +36,7 @@ module Stack.Build.Cache import Stack.Prelude import Crypto.Hash (hashWith, SHA256(..)) import qualified Data.ByteArray as Mem (convert) +import Data.ByteString.Builder (byteString) import qualified Data.Map as M import qualified Data.Set as Set import qualified Data.Text as T @@ -154,6 +157,18 @@ tryGetFileMod fp = liftIO $ either (const Nothing) (Just . modificationTime) <$> tryIO (getFileStatus fp) +-- | Try to read the project root from the last build of a package +tryGetPackageProjectRoot :: HasEnvConfig env + => Path Abs Dir -> RIO env (Maybe ByteString) +tryGetPackageProjectRoot dir = do + fp <- toFilePath <$> configPackageProjectRoot dir + tryReadFileBinary fp + +tryReadFileBinary :: MonadIO m => FilePath -> m (Maybe ByteString) +tryReadFileBinary fp = + liftIO $ either (const Nothing) Just <$> + tryIO (readFileBinary fp) + -- | Write the dirtiness cache for this package's files. writeBuildCache :: HasEnvConfig env => Path Abs Dir @@ -197,6 +212,16 @@ writeSetupConfigMod dir (Just x) = do writeBinaryFileAtomic fp "Just used for its modification time" liftIO $ setFileTimes (toFilePath fp) x x +-- | See 'tryGetPackageProjectRoot' +writePackageProjectRoot + :: HasEnvConfig env + => Path Abs Dir + -> ByteString + -> RIO env () +writePackageProjectRoot dir projectRoot = do + fp <- configPackageProjectRoot dir + writeBinaryFileAtomic fp (byteString projectRoot) + -- | Delete the caches for the project. deleteCaches :: HasEnvConfig env => Path Abs Dir -> RIO env () deleteCaches dir diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 8fbf4489cd..711eef6001 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -849,6 +849,7 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = liftIO $ either (const Nothing) (Just . modificationTime) <$> tryJust (guard . isDoesNotExistError) (getFileStatus (toFilePath setupConfigfp)) newSetupConfigMod <- getNewSetupConfigMod + newProjectRoot <- S8.pack . toFilePath <$> view projectRootL -- See https://github.com/commercialhaskell/stack/issues/3554 taskAnyMissingHack <- view $ actualCompilerVersionL.to getGhcVersion.to (< mkVersion [8, 4]) needConfig <- @@ -870,10 +871,12 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = -- Cabal's setup-config is created per OS/Cabal version, multiple -- projects using the same package could get a conflict because of this mOldSetupConfigMod <- tryGetSetupConfigMod pkgDir + mOldProjectRoot <- tryGetPackageProjectRoot pkgDir return $ fmap ignoreComponents mOldConfigCache /= Just (ignoreComponents newConfigCache) || mOldCabalMod /= Just newCabalMod || mOldSetupConfigMod /= newSetupConfigMod + || mOldProjectRoot /= Just newProjectRoot let ConfigureOpts dirs nodirs = configCacheOpts newConfigCache when (taskBuildTypeConfig task) ensureConfigureScript @@ -912,6 +915,7 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = -- check if our config mod file is newer than the file above, but this -- seems reasonable too. getNewSetupConfigMod >>= writeSetupConfigMod pkgDir + writePackageProjectRoot pkgDir newProjectRoot return needConfig where diff --git a/src/Stack/Constants/Config.hs b/src/Stack/Constants/Config.hs index 1c1f8a3418..0c261be34c 100644 --- a/src/Stack/Constants/Config.hs +++ b/src/Stack/Constants/Config.hs @@ -11,6 +11,7 @@ module Stack.Constants.Config , projectDockerSandboxDir , configCabalMod , configSetupConfigMod + , configPackageProjectRoot , buildCachesDir , testSuccessFile , testBuiltFile @@ -85,6 +86,15 @@ configSetupConfigMod dir = ( $(mkRelFile "stack-setup-config-mod")) (distDirFromDir dir) +-- | The filename used for the project root from the last build of a package +configPackageProjectRoot :: (MonadThrow m, MonadReader env m, HasEnvConfig env) + => Path Abs Dir -- ^ Package directory. + -> m (Path Abs File) +configPackageProjectRoot dir = + liftM + ( $(mkRelFile "stack-project-root")) + (distDirFromDir dir) + -- | Directory for HPC work. hpcDirFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) diff --git a/test/integration/lib/StackTest.hs b/test/integration/lib/StackTest.hs index 65089b37f9..e894f42fcd 100644 --- a/test/integration/lib/StackTest.hs +++ b/test/integration/lib/StackTest.hs @@ -289,15 +289,20 @@ removeDirIgnore fp = removeDirectoryRecursive fp `catch` \e -> then return () else throwIO e --- | Changes working directory to Stack source directory -withSourceDirectory :: HasCallStack => IO () -> IO () -withSourceDirectory action = do - dir <- stackSrc +-- | Changes to the specified working directory. +withCwd :: HasCallStack => FilePath -> IO () -> IO () +withCwd dir action = do currentDirectory <- getCurrentDirectory let enterDir = setCurrentDirectory dir exitDir = setCurrentDirectory currentDirectory bracket_ enterDir exitDir action +-- | Changes working directory to Stack source directory. +withSourceDirectory :: HasCallStack => IO () -> IO () +withSourceDirectory action = do + dir <- stackSrc + withCwd dir action + -- | Mark a test as superslow, only to be run when explicitly requested. superslow :: HasCallStack => IO () -> IO () superslow inner = do diff --git a/test/integration/tests/5680-share-package-across-projects/Main.hs b/test/integration/tests/5680-share-package-across-projects/Main.hs new file mode 100644 index 0000000000..1a04eb87d5 --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/Main.hs @@ -0,0 +1,8 @@ +import StackTest + +main :: IO () +main = do + stackEnv <- stackExe + withCwd "package-a" $ stack ["build"] + withCwd "package-b" $ stack ["build"] + withCwd "package-a" $ stack ["build"] diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-a/package.yaml b/test/integration/tests/5680-share-package-across-projects/files/package-a/package.yaml new file mode 100644 index 0000000000..fa0e177ed7 --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-a/package.yaml @@ -0,0 +1,6 @@ +name: package-a +version: 0.1.0.0 +dependencies: +- base >= 4.7 && < 5 +library: + source-dirs: src diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-a/src/Lib.hs b/test/integration/tests/5680-share-package-across-projects/files/package-a/src/Lib.hs new file mode 100644 index 0000000000..d36ff2714d --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-a/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-a/stack.yaml b/test/integration/tests/5680-share-package-across-projects/files/package-a/stack.yaml new file mode 100644 index 0000000000..5758329d3e --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-a/stack.yaml @@ -0,0 +1,4 @@ +resolver: lts-17.15 +packages: +- . +- ../package-c diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-b/package.yaml b/test/integration/tests/5680-share-package-across-projects/files/package-b/package.yaml new file mode 100644 index 0000000000..2b30b1e802 --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-b/package.yaml @@ -0,0 +1,6 @@ +name: package-b +version: 0.1.0.0 +dependencies: +- base >= 4.7 && < 5 +library: + source-dirs: src diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-b/src/Lib.hs b/test/integration/tests/5680-share-package-across-projects/files/package-b/src/Lib.hs new file mode 100644 index 0000000000..d36ff2714d --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-b/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-b/stack.yaml b/test/integration/tests/5680-share-package-across-projects/files/package-b/stack.yaml new file mode 100644 index 0000000000..5758329d3e --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-b/stack.yaml @@ -0,0 +1,4 @@ +resolver: lts-17.15 +packages: +- . +- ../package-c diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-c/package.yaml b/test/integration/tests/5680-share-package-across-projects/files/package-c/package.yaml new file mode 100644 index 0000000000..b1077c1165 --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-c/package.yaml @@ -0,0 +1,6 @@ +name: package-c +version: 0.1.0.0 +dependencies: +- base >= 4.7 && < 5 +library: + source-dirs: src diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-c/src/Lib.hs b/test/integration/tests/5680-share-package-across-projects/files/package-c/src/Lib.hs new file mode 100644 index 0000000000..d36ff2714d --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-c/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/integration/tests/5680-share-package-across-projects/files/package-c/stack.yaml b/test/integration/tests/5680-share-package-across-projects/files/package-c/stack.yaml new file mode 100644 index 0000000000..913089bf48 --- /dev/null +++ b/test/integration/tests/5680-share-package-across-projects/files/package-c/stack.yaml @@ -0,0 +1,3 @@ +resolver: lts-17.15 +packages: +- .