Merge pull request #3982 from mihaimaruseac/mm-ghci-internal-libs

Handle internal libraries in GHCi.

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

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

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)

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

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

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

test/integration/tests/3926-ghci-with-sublibraries/files/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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

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"

test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v1

@@ -0,0 +1 @@
+module Internal where

test/integration/tests/3926-ghci-with-sublibraries/files/src-internal/Internal.v2

@@ -0,0 +1,4 @@
+module Internal where
+
+testInt :: Int
+testInt = 42

test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v1

@@ -0,0 +1,3 @@
+module Lib where
+
+import Internal

test/integration/tests/3926-ghci-with-sublibraries/files/src/Lib.v2

@@ -0,0 +1,6 @@
+module Lib where
+
+import Internal
+
+testStr :: String
+testStr = "OK"

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