diff --git a/ChangeLog.md b/ChangeLog.md index 45001c931c..cb46d53451 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -14,6 +14,11 @@ Other enhancements: Bug fixes: * `~/.stack/config.yaml` and `stack.yaml` terminating by newline +* `stack ghci` on a package with internal libraries was erroneously looking + for a wrong package corresponding to the internal library and failing to + load any module. This has been fixed now and changes to the code in the + library and the sublibrary are properly tracked. See + [#3926](https://github.com/commercialhaskell/stack/issues/3926). ## v1.7.1 diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index c2a624dedc..bf98d7782b 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -661,8 +661,9 @@ wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll ProjectPackage) pkg = S.fromList $ (case packageLibraries pkg of NoLibraries -> [] - HasLibraries _names -> [CLib]) ++ -- FIXME. This ignores sub libraries and foreign libraries. Is that OK? + HasLibraries names -> CLib : map CInternalLib (S.toList names)) ++ map CExe (S.toList (packageExes pkg)) <> + map CInternalLib (S.toList $ packageInternalLibraries pkg) <> (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <> (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else []) wantedPackageComponents _ _ _ = S.empty diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 47e43bd3ea..0a4edeaffd 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -64,6 +64,7 @@ import qualified Distribution.Types.CondTree as Cabal import qualified Distribution.Types.ExeDependency as Cabal import Distribution.Types.ForeignLib import qualified Distribution.Types.LegacyExeDependency as Cabal +import Distribution.Types.MungedPackageName import qualified Distribution.Types.UnqualComponentName as Cabal import qualified Distribution.Verbosity as D import Lens.Micro (lens) @@ -279,6 +280,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg | null extraLibNames -> NoLibraries | otherwise -> error "Package has buildable sublibraries but no buildable libraries, I'm giving up" Just _ -> HasLibraries foreignLibNames + , packageInternalLibraries = subLibNames , packageTests = M.fromList [(T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t) | t <- testSuites pkgNoMod @@ -299,8 +301,13 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageOpts = GetPackageOpts $ \sourceMap installedMap omitPkgs addPkgs cabalfp -> do (componentsModules,componentFiles,_,_) <- getPackageFiles pkgFiles cabalfp + let internals = S.toList $ internalLibComponents $ M.keysSet componentsModules + excludedInternals <- mapM parsePackageName internals + mungedInternals <- mapM (parsePackageName . toInternalPackageMungedName) internals componentsOpts <- - generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componentFiles + generatePkgDescOpts sourceMap installedMap + (excludedInternals ++ omitPkgs) (mungedInternals ++ addPkgs) + cabalfp pkg componentFiles return (componentsModules,componentFiles,componentsOpts) , packageHasExposedModules = maybe False @@ -325,6 +332,10 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg $ filter (buildable . foreignLibBuildInfo) $ foreignLibs pkg + toInternalPackageMungedName + = T.pack . unMungedPackageName . computeCompatPackageName (pkgName pkgId) + . Just . Cabal.mkUnqualComponentName . T.unpack + -- Gets all of the modules, files, build files, and data files that -- constitute the package. This is primarily used for dirtiness -- checking during build, as well as use by "stack ghci" @@ -411,6 +422,12 @@ generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componen [] (return . generate CLib . libBuildInfo) (library pkg) + , mapMaybe + (\sublib -> do + let maybeLib = CInternalLib . T.pack . Cabal.unUnqualComponentName <$> libName sublib + flip generate (libBuildInfo sublib) <$> maybeLib + ) + (subLibraries pkg) , fmap (\exe -> generate @@ -698,7 +715,7 @@ packageDescModulesAndFiles :: PackageDescription -> RIO Ctx (Map NamedComponent (Map ModuleName (Path Abs File)), Map NamedComponent (Set DotCabalPath), Set (Path Abs File), [PackageWarning]) packageDescModulesAndFiles pkg = do - (libraryMods,libDotCabalFiles,libWarnings) <- -- FIXME add in sub libraries + (libraryMods,libDotCabalFiles,libWarnings) <- maybe (return (M.empty, M.empty, [])) (asModuleAndFileMap libComponent libraryFiles) diff --git a/src/Stack/Types/NamedComponent.hs b/src/Stack/Types/NamedComponent.hs index 68b0a52dda..09bdc3fbf3 100644 --- a/src/Stack/Types/NamedComponent.hs +++ b/src/Stack/Types/NamedComponent.hs @@ -8,7 +8,9 @@ module Stack.Types.NamedComponent , exeComponents , testComponents , benchComponents + , internalLibComponents , isCLib + , isCInternalLib , isCExe , isCTest , isCBench @@ -59,10 +61,20 @@ benchComponents = Set.fromList . mapMaybe mBenchName . Set.toList mBenchName (CBench name) = Just name mBenchName _ = Nothing +internalLibComponents :: Set NamedComponent -> Set Text +internalLibComponents = Set.fromList . mapMaybe mInternalName . Set.toList + where + mInternalName (CInternalLib name) = Just name + mInternalName _ = Nothing + isCLib :: NamedComponent -> Bool isCLib CLib{} = True isCLib _ = False +isCInternalLib :: NamedComponent -> Bool +isCInternalLib CInternalLib{} = True +isCInternalLib _ = False + isCExe :: NamedComponent -> Bool isCExe CExe{} = True isCExe _ = False diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index d0a6b55458..6eb77567ae 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -129,6 +129,7 @@ data Package = ,packageFlags :: !(Map FlagName Bool) -- ^ Flags used on package. ,packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags. ,packageLibraries :: !PackageLibraries -- ^ does the package have a buildable library stanza? + ,packageInternalLibraries :: !(Set Text) -- ^ names of internal libraries ,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites ,packageBenchmarks :: !(Set Text) -- ^ names of benchmarks ,packageExes :: !(Set Text) -- ^ names of executables diff --git a/test/integration/tests/3926-ghci-with-sublibraries/Main.hs b/test/integration/tests/3926-ghci-with-sublibraries/Main.hs new file mode 100644 index 0000000000..6dc68de1d7 --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/Main.hs @@ -0,0 +1,44 @@ +import Control.Concurrent +import Control.Monad.IO.Class +import Control.Monad +import Data.List +import StackTest + +main :: IO () +main = do + stack ["clean"] -- to make sure we can load the code even after a clean + copy "src/Lib.v1" "src/Lib.hs" + copy "src-internal/Internal.v1" "src-internal/Internal.hs" + forkIO fileEditingThread + replThread + +replThread :: IO () +replThread = repl [] $ do + replCommand ":main" + line <- replGetLine + when (line /= "hello world") $ error "Main module didn't load correctly." + liftIO $ threadDelay 1000000 -- wait for an edit of the internal library + reloadAndTest "testInt" "42" "Internal library didn't reload." + liftIO $ threadDelay 1000000 -- wait for an edit of the internal library + reloadAndTest "testStr" "\"OK\"" "Main library didn't reload." + +fileEditingThread :: IO () +fileEditingThread = do + threadDelay 1000000 + -- edit the internal library and return to ghci + copy "src-internal/Internal.v2" "src-internal/Internal.hs" + threadDelay 1000000 + -- edit the internal library and end thread, returning to ghci + copy "src/Lib.v2" "src/Lib.hs" + +reloadAndTest :: String -> String -> String -> Repl () +reloadAndTest cmd exp err = do + reload + replCommand cmd + line <- replGetLine + unless (exp `isSuffixOf` line) $ error err + +reload :: Repl () +reload = replCommand ":reload" >> loop + where + loop = replGetLine >>= \line -> unless ("Ok" `isInfixOf` line) loop diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/Setup.hs b/test/integration/tests/3926-ghci-with-sublibraries/files/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/files.cabal b/test/integration/tests/3926-ghci-with-sublibraries/files/files.cabal new file mode 100644 index 0000000000..867797cb7b --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/files.cabal @@ -0,0 +1,22 @@ +name: files +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 2.0 + +library + hs-source-dirs: src + exposed-modules: Lib + build-depends: base, lib + default-language: Haskell2010 + +library lib + hs-source-dirs: src-internal + exposed-modules: Internal + build-depends: base + default-language: Haskell2010 + +executable exe + hs-source-dirs: src-exe + main-is: Main.hs + build-depends: base, files + default-language: Haskell2010 diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/src-exe/Main.hs b/test/integration/tests/3926-ghci-with-sublibraries/files/src-exe/Main.hs new file mode 100644 index 0000000000..cafae24793 --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/src-exe/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Lib + +main :: IO () +main = do + putStrLn "hello world" diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v1 b/test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v1 new file mode 100644 index 0000000000..d066bb085e --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v1 @@ -0,0 +1 @@ +module Internal where diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v2 b/test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v2 new file mode 100644 index 0000000000..da8a642c7b --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v2 @@ -0,0 +1,4 @@ +module Internal where + +testInt :: Int +testInt = 42 diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v1 b/test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v1 new file mode 100644 index 0000000000..1369151610 --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v1 @@ -0,0 +1,3 @@ +module Lib where + +import Internal diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v2 b/test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v2 new file mode 100644 index 0000000000..d9892d6826 --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v2 @@ -0,0 +1,6 @@ +module Lib where + +import Internal + +testStr :: String +testStr = "OK" diff --git a/test/integration/tests/3926-ghci-with-sublibraries/files/stack.yaml b/test/integration/tests/3926-ghci-with-sublibraries/files/stack.yaml new file mode 100644 index 0000000000..df13716817 --- /dev/null +++ b/test/integration/tests/3926-ghci-with-sublibraries/files/stack.yaml @@ -0,0 +1,4 @@ +resolver: ghc-8.2.2 +extra-deps: +- stm-2.4.4.1 +- mtl-2.2.1