Merge pull request #3795 from commercialhaskell/fix-ghci-autogen-path-3791

Use per-component build directories for ghci with Cabal>=2.0 #3791

Author: mgsloan

ChangeLog.md

@@ -105,6 +105,8 @@ Bug fixes:
   resilient against SIGKILL and machine failure. See
   [hackage-security #187](https://github.com/haskell/hackage-security/issues/187)
   and [#3073](https://github.com/commercialhaskell/stack/issues/3073).
+* `stack ghci` now uses correct paths for autogen files with
+  [#3791](https://github.com/commercialhaskell/stack/issues/3791)
 
 
 ## v1.6.3.1

src/Stack/Build/ConstructPlan.hs

@@ -27,7 +27,7 @@ import qualified Data.Map.Strict as M
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import           Data.Text.Encoding (decodeUtf8With)
+import           Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import           Data.Text.Encoding.Error (lenientDecode)
 import qualified Distribution.Text as Cabal
 import qualified Distribution.Version as Cabal
@@ -727,7 +727,7 @@ checkDirtiness ps installed package present wanted = do
             , configCacheDeps = Set.fromList $ Map.elems present
             , configCacheComponents =
                 case ps of
-                    PSFiles lp _ -> Set.map renderComponent $ lpComponents lp
+                    PSFiles lp _ -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
                     PSIndex{} -> Set.empty
             , configCacheHaddock =
                 shouldHaddockPackage buildOpts wanted (packageName package) ||

src/Stack/Build/Execute.hs

@@ -790,7 +790,7 @@ getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBenc
             , configCacheDeps = allDeps
             , configCacheComponents =
                 case taskType of
-                    TTFiles lp _ -> Set.map renderComponent $ lpComponents lp
+                    TTFiles lp _ -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
                     TTIndex{} -> Set.empty
             , configCacheHaddock =
                 shouldHaddockPackage eeBuildOpts eeWanted (packageIdentifierName taskProvides)
@@ -1411,9 +1411,9 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
                 -- https://github.com/commercialhaskell/stack/issues/2649
                 -- is resolved, we will want to partition the warnings
                 -- based on variety, and output in different lists.
-                let showModuleWarning (UnlistedModulesWarning mcomp modules) =
+                let showModuleWarning (UnlistedModulesWarning comp modules) =
                       "- In" <+>
-                      maybe "the library component" (\c -> fromString c <+> "component") mcomp <>
+                      fromString (T.unpack (renderComponent comp)) <>
                       ":" <> line <>
                       indent 4 (mconcat $ intersperse line $ map (styleGood . fromString . C.display) modules)
                 forM_ mlocalWarnings $ \(cabalfp, warnings) -> do
@@ -1938,7 +1938,7 @@ cabalIsSatisfied = all (== ExecutableBuilt) . M.elems
 -- Test-suite and benchmark build components.
 finalComponentOptions :: LocalPackage -> [String]
 finalComponentOptions lp =
-    map (T.unpack . decodeUtf8 . renderComponent) $
+    map (T.unpack . renderComponent) $
     Set.toList $
     Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp)
 

src/Stack/Ghci.hs

@@ -399,7 +399,7 @@ runGhci GhciOpts{..} targets mainIsTargets pkgs extraFiles exposePackages = do
                 scriptPath <- writeGhciScript tmpDirectory (renderScript isIntero pkgs mainFile ghciOnlyMain extraFiles)
                 execGhci (macrosOptions ++ ["-ghci-script=" <> toFilePath scriptPath])
 
-writeMacrosFile :: (MonadIO m) => Path Abs Dir -> [GhciPkgInfo] -> m [String]
+writeMacrosFile :: HasRunner env => Path Abs Dir -> [GhciPkgInfo] -> RIO env [String]
 writeMacrosFile tmpDirectory packages = do
     preprocessCabalMacros packages macrosFile
   where
@@ -808,12 +808,21 @@ getExtraLoadDeps loadAllDeps sourceMap targets =
             (_, Just PSIndex{}) -> return loadAllDeps
             (_, _) -> return False
 
-preprocessCabalMacros :: MonadIO m => [GhciPkgInfo] -> Path Abs File -> m [String]
-preprocessCabalMacros pkgs out = liftIO $ do
-    let fps = nubOrd (concatMap (mapMaybe (bioCabalMacros . snd) . ghciPkgOpts) pkgs)
-    files <- mapM (S8.readFile . toFilePath) fps
+preprocessCabalMacros :: HasRunner env => [GhciPkgInfo] -> Path Abs File -> RIO env [String]
+preprocessCabalMacros pkgs out = do
+    fps <- fmap (nubOrd . catMaybes . concat) $
+        forM pkgs $ \pkg -> forM (ghciPkgOpts pkg) $ \(_, bio) -> do
+            let cabalMacros = bioCabalMacros bio
+            exists <- liftIO $ doesFileExist cabalMacros
+            if exists
+                then return $ Just cabalMacros
+                else do
+                    prettyWarnL ["Didn't find expected autogen file:", display cabalMacros]
+                    return Nothing
+    files <- liftIO $ mapM (S8.readFile . toFilePath) fps
     if null files then return [] else do
-        S8.writeFile (toFilePath out) $ S8.concat $ map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files
+        liftIO $ S8.writeFile (toFilePath out) $ S8.concat $
+            map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files
         return ["-optP-include", "-optP" <> toFilePath out]
 
 setScriptPerms :: MonadIO m => FilePath -> m ()
@@ -846,50 +855,6 @@ hasLocalComp p t =
         TargetAll ProjectPackage -> True
         _ -> False
 
-
-{- Copied from Stack.Ide, may be useful in the future
-
--- | Get options and target files for the given package info.
-getPackageOptsAndTargetFiles
-    :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env)
-    => Path Abs Dir -> GhciPkgInfo -> m ([FilePath], [FilePath])
-getPackageOptsAndTargetFiles pwd pkg = do
-    dist <- distDirFromDir (ghciPkgDir pkg)
-    let autogen = autogenDir dist
-    paths_foo <-
-        liftM
-            (autogen </>)
-            (parseRelFile
-                 ("Paths_" ++ packageNameString (ghciPkgName pkg) ++ ".hs"))
-    paths_foo_exists <- doesFileExist paths_foo
-    let ghcOptions bio =
-            bioOneWordOpts bio ++
-            bioOpts bio ++
-            bioPackageFlags bio ++
-            maybe [] (\cabalMacros -> ["-optP-include", "-optP" <> toFilePath cabalMacros]) (bioCabalMacros bio)
-    return
-        ( ("--dist-dir=" <> toFilePathNoTrailingSep dist) :
-          -- FIXME: use compilerOptionsCabalFlag
-          map ("--ghc-option=" ++) (concatMap (ghcOptions . snd) (ghciPkgOpts pkg))
-        , mapMaybe
-              (fmap toFilePath . stripProperPrefix pwd)
-              (S.toList (ghciPkgCFiles pkg) <> S.toList (ghciPkgModFiles pkg) <>
-               [paths_foo | paths_foo_exists]))
-
--- | List load targets for a package target.
-targetsCmd :: Text -> GlobalOpts -> IO ()
-targetsCmd target go@GlobalOpts{..} =
-    withBuildConfig go $
-    do let boptsCli = defaultBuildOptsCLI { boptsCLITargets = [target] }
-       (_realTargets,_,pkgs) <- ghciSetup (ideGhciOpts boptsCli)
-       pwd <- getCurrentDir
-       targets <-
-           fmap
-               (concat . snd . unzip)
-               (mapM (getPackageOptsAndTargetFiles pwd) pkgs)
-       forM_ targets (liftIO . putStrLn)
--}
-
 -- | Run a command and grab the first line of stdout, dropping
 -- stderr's contexts completely.
 runGrabFirstLine :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env String