Fix stale Backpack CInst planning for installed signatures

src/Stack/Build/ConstructPlan.hs

@@ -34,7 +34,7 @@ import           RIO.State
                    ( State, StateT (..), execState, get, modify, modify', put )
 import           RIO.Writer ( WriterT (..), pass, tell )
 import           Stack.Build.Backpack
-                   ( addInstantiationTasks, upgradeFoundIndefinites )
+                   ( addInstantiationTasks, loadFoundIndefiniteTasks )
 import           Stack.Build.Cache ( tryGetFlagCache )
 import           Stack.Build.Haddock ( shouldHaddockDeps )
 import           Stack.Build.Source ( loadLocalPackage )
@@ -56,7 +56,8 @@ import           Stack.Types.Build.ConstructPlan
                    ( AddDepRes (..), CombinedMap, Ctx (..), LibraryMap, M
                    , MissingPresentDeps (..), PackageInfo (..), PackageLoader
                    , ToolWarning(..), UnregisterState (..), W (..)
-                   , adrHasLibrary, adrVersion, isAdrToInstall, toTask
+                   , adrHasLibrary, adrVersion, isAdrToInstall, processAdr
+                   , toTask
                    )
 import           Stack.Types.Build.Exception
                    ( BadDependency (..), BuildException (..)
@@ -95,14 +96,14 @@ import           Stack.Types.NamedComponent
                    )
 import           Stack.Types.Package
                    ( ExeName (..), LocalPackage (..), Package (..)
-                   , PackageSource (..), installedMapGhcPkgId
-                   , packageIdentifier, psVersion, runMemoizedWith
+                   , PackageSource (..), packageIdentifier, psVersion
+                   , runMemoizedWith
                    )
 import           Stack.Types.Plan
                    ( ComponentKey (..), Plan (..), Task (..)
                    , TaskConfigOpts (..), TaskType (..), componentKeyPkgName
                    , fromComponentKey, installLocationIsMutable, taskIsTarget
-                   , taskLocation, taskProvides, taskTargetIsMutable
+                   , taskLocation, taskProvides
                    )
 import           Stack.Types.ProjectConfig ( isPCGlobalProject )
 import           Stack.Types.Runner ( HasRunner (..), globalOptsL )
@@ -226,9 +227,9 @@ constructPlan
         errs = errlibs ++ errfinals
     if null errs
       then do
-        -- Upgrade ADRFound entries to ADRToInstall for indefinite packages
-        -- whose source is available. This ensures addInstantiationTasks can
-        -- clone their Task to create CInst instantiation tasks.
+        -- Load source-backed templates for clean installed indefinite packages.
+        -- This lets addInstantiationTasks clone them for CInst tasks without
+        -- turning their ADRFound CLib entries into build tasks.
         let loadPkg w x y z = applyForceCustomBuild globalCabalVersion
                              <$> loadPackage0 w x y z
             -- Build a module lookup map from installed packages (dump data).
@@ -239,11 +240,15 @@ constructPlan
               | dp <- allDumpPkgs
               , isNothing dp.sublib  -- Only main libraries
               ]
-        adrs' <- upgradeFoundIndefinites
-                   loadPkg econfig ctx.combinedMap ctx.baseConfigOpts adrs
-        let expandedAdrs = concatMap (uncurry expandToComponentKeys) adrs'
+        foundIndefiniteTasks <- loadFoundIndefiniteTasks
+                   loadPkg econfig sources ctx.combinedMap ctx.baseConfigOpts adrs
+        let expandedAdrs = concatMap (uncurry expandToComponentKeys) adrs
             (withInstantiations, bpWarnings) =
-              addInstantiationTasks installedModules adrs' expandedAdrs
+              addInstantiationTasks
+                installedModules
+                foundIndefiniteTasks
+                adrs
+                expandedAdrs
             tasks = Map.fromList $ mapMaybe
               (toMaybe . second toTask)
               withInstantiations
@@ -416,10 +421,17 @@ mkUnregisterLocal componentTasks dirtyReason localDumpPkgs initialBuildSteps =
   -- directly or transitively depending on it.
   loop Map.empty localDumpPkgs
  where
-  -- Derive a per-package task map: pick one representative task per package.
+  -- Derive a per-package task map: pick one representative non-CInst task per
+  -- package. A CInst task registers a Backpack instantiation, but it relies on
+  -- the existing indefinite library registration for the same package name.
+  -- Treating CInst-only packages as normal rebuilds unregisters that
+  -- indefinite unit before the CInst configure step can use it.
   tasks :: Map PackageName Task
   tasks = Map.fromList
-    [ (componentKeyPkgName ck, t) | (ck, t) <- Map.toList componentTasks ]
+    [ (componentKeyPkgName ck, t)
+    | (ck, t) <- Map.toList componentTasks
+    , not (componentKeyIsCInst ck)
+    ]
 
   loop ::
        Map GhcPkgId (PackageIdentifier, Text)
@@ -505,6 +517,10 @@ mkUnregisterLocal componentTasks dirtyReason localDumpPkgs initialBuildSteps =
       relevantPkgName :: PackageName
       relevantPkgName = maybe (pkgName ident) pkgName mParentLibId
 
+  componentKeyIsCInst :: ComponentKey -> Bool
+  componentKeyIsCInst (ComponentKey _ CInst{}) = True
+  componentKeyIsCInst _ = False
+
 -- | Given a t'LocalPackage' and its test\/benchmark 'Package', adds a
 -- t'Task' for running its tests and benchmarks. Resolves the package's deps
 -- via 'addPackageDeps' (in the common case these have already been resolved
@@ -1154,31 +1170,6 @@ adrInRange pkgId name range adr = if adrVersion adr `withinRange` range
             , reason <> "."
             ]
 
--- | Given a result of 'addDep', yields a triple indicating: (1) if the
--- dependency is to be installed, its package identifier; (2) if the dependency
--- is installed and a library, its package identifier and 'GhcPkgId'; and (3) if
--- the dependency is, or will be when installed, mutable or immutable.
-processAdr ::
-     AddDepRes
-  -> MissingPresentDeps
-processAdr adr = case adr of
-  ADRToInstall task ->
-    MissingPresentDeps
-      { missingPackages = Set.singleton $ taskProvides task
-      , presentPackages = mempty
-      , isMutable = taskTargetIsMutable task
-      }
-  ADRFound loc installed ->
-    MissingPresentDeps
-      { missingPackages = mempty
-      , presentPackages = presentPackagesV
-      , isMutable = installLocationIsMutable loc
-      }
-   where
-    presentPackagesV = case installed of
-      Library ident installedInfo -> installedMapGhcPkgId ident installedInfo
-      _ -> Map.empty
-
 checkDirtiness ::
      PackageSource
   -> Installed

src/Stack/Types/Build/ConstructPlan.hs

@@ -20,6 +20,7 @@ module Stack.Types.Build.ConstructPlan
   , toTask
   , adrVersion
   , adrHasLibrary
+  , processAdr
   , isAdrToInstall
   , Ctx (..)
   , PackageLoader
@@ -29,6 +30,8 @@ module Stack.Types.Build.ConstructPlan
   ) where
 
 import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import           RIO.Process ( HasProcessContext (..) )
 import           RIO.State ( StateT )
 import           RIO.Writer ( WriterT (..) )
@@ -52,11 +55,14 @@ import           Stack.Types.Installed
 import           Stack.Types.IsMutable ( IsMutable )
 import           Stack.Types.Package
                    ( ExeName (..), LocalPackage (..), Package (..)
-                   , PackageSource (..)
+                   , PackageSource (..), installedMapGhcPkgId
                    )
 import           Stack.Types.ParentMap ( ParentMap )
 import           Stack.Types.Plan
-                    ( ComponentKey, Task (..), TaskType (..), taskProvides )
+                    ( ComponentKey, Task (..), TaskType (..)
+                    , installLocationIsMutable, taskProvides
+                    , taskTargetIsMutable
+                    )
 import           Stack.Types.Platform ( HasPlatform (..) )
 import           Stack.Types.Runner ( HasRunner (..) )
 
@@ -152,6 +158,32 @@ adrHasLibrary (ADRToInstall task) = case task.taskType of
 adrHasLibrary (ADRFound _ Library{}) = True
 adrHasLibrary (ADRFound _ Executable{}) = False
 
+-- | Given a result of 'Stack.Build.ConstructPlan.addDep', yields a triple
+-- indicating: (1) if the dependency is to be installed, its package identifier;
+-- (2) if the dependency is installed and a library, its package identifier and
+-- 'GhcPkgId'; and (3) if the dependency is, or will be when installed, mutable
+-- or immutable.
+processAdr ::
+     AddDepRes
+  -> MissingPresentDeps
+processAdr adr = case adr of
+  ADRToInstall task ->
+    MissingPresentDeps
+      { missingPackages = Set.singleton $ taskProvides task
+      , presentPackages = mempty
+      , isMutable = taskTargetIsMutable task
+      }
+  ADRFound loc installed ->
+    MissingPresentDeps
+      { missingPackages = mempty
+      , presentPackages = presentPackagesV
+      , isMutable = installLocationIsMutable loc
+      }
+   where
+    presentPackagesV = case installed of
+      Library ident installedInfo -> installedMapGhcPkgId ident installedInfo
+      _ -> Map.empty
+
 data MissingPresentDeps = MissingPresentDeps
   { missingPackages :: !(Set PackageIdentifier)
   , presentPackages :: !(Map MungedPackageId GhcPkgId)

tests/integration/tests/backpack-stale-cinst-consumer-change/Main.hs

@@ -0,0 +1,63 @@
+-- Regression test for stale Backpack instantiation state when the final
+-- Backpack consumer changes. consumer-pkg is dirty, but both indefinite
+-- signature packages are clean and already installed.
+
+import Control.Monad ( unless )
+import Data.List ( isInfixOf )
+import System.Directory ( removeFile )
+import StackTest
+
+main :: IO ()
+main = do
+  -- Build all four packages. This exercises:
+  -- 1. str-sig CLib (indefinite, typecheck-only)
+  -- 2. impl-pkg CLib (concrete Str + Logger)
+  -- 3. str-sig CInst (instantiation with impl-pkg's Str)
+  -- 4. logger-sig CLib (indefinite, typecheck-only, inherits Str hole)
+  -- 5. logger-sig CInst (fills BOTH Logger and Str holes)
+  -- 6. consumer-pkg CLib + CExe
+  stack ["build"]
+
+  -- Verify the consumer executable calls through the transitive chain
+  stackCheckStdout ["exec", "consumer-demo"] $ \out ->
+    unless ("[LOG] Hello from transitive chain" `isInfixOf` out) $
+      error $ "Expected '[LOG] Hello from transitive chain' in output, got: "
+            ++ show out
+
+  replaceFile "consumer-pkg/src/Consumer.hs" $ unlines
+    [ "module Consumer where"
+    , ""
+    , "import LogHelper (greetWithLog)"
+    , ""
+    , "hello :: String"
+    , "hello = greetWithLog ++ \" after consumer edit\""
+    ]
+
+  -- Rebuild should succeed because only the final consumer changed.
+  stackCheckStderr ["build"] $ \err ->
+    expectBuildLine "consumer-pkg" "Compiling Consumer" err
+
+  -- Verify output still correct after rebuild
+  stackCheckStdout ["exec", "consumer-demo"] $ \out ->
+    unless ("[LOG] Hello from transitive chain after consumer edit" `isInfixOf` out) $
+      error $
+           "Expected edited consumer-pkg output after rebuild, got: "
+        ++ show out
+
+replaceFile :: FilePath -> String -> IO ()
+replaceFile file contents = do
+  removeFile file
+  writeFile file contents
+
+expectBuildLine :: String -> String -> String -> IO ()
+expectBuildLine package marker err =
+  unless (any matches $ lines err) $
+    error $
+         "Expected build output line containing "
+      ++ show package
+      ++ " and "
+      ++ show marker
+      ++ ", got stderr: "
+      ++ show err
+ where
+  matches line = package `isInfixOf` line && marker `isInfixOf` line

tests/integration/tests/backpack-stale-cinst-consumer-change/files/.gitignore

@@ -0,0 +1,4 @@
+consumer-pkg.cabal
+impl-pkg.cabal
+logger-sig.cabal
+str-sig.cabal

tests/integration/tests/backpack-stale-cinst-consumer-change/files/consumer-pkg/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Consumer (hello)
+
+main :: IO ()
+main = putStrLn hello

tests/integration/tests/backpack-stale-cinst-consumer-change/files/consumer-pkg/package.yaml

@@ -0,0 +1,24 @@
+spec-version: 0.36.0
+
+name: consumer-pkg
+
+dependencies:
+- base
+
+library:
+  source-dirs: src
+  dependencies:
+  - name: str-sig
+    mixin:
+    - requires (Str as Str)
+  - name: logger-sig
+    mixin:
+    - requires (Logger as Logger)
+  - impl-pkg
+
+executables:
+  consumer-demo:
+    source-dirs: app
+    main: Main.hs
+    dependencies:
+    - consumer-pkg

tests/integration/tests/backpack-stale-cinst-consumer-change/files/consumer-pkg/src/Consumer.hs

@@ -0,0 +1,6 @@
+module Consumer where
+
+import LogHelper (greetWithLog)
+
+hello :: String
+hello = greetWithLog

tests/integration/tests/backpack-stale-cinst-consumer-change/files/impl-pkg/package.yaml

@@ -0,0 +1,9 @@
+spec-version: 0.36.0
+
+name: impl-pkg
+
+dependencies:
+- base
+
+library:
+  source-dirs: src

tests/integration/tests/backpack-stale-cinst-consumer-change/files/impl-pkg/src/Logger.hs

@@ -0,0 +1,4 @@
+module Logger where
+
+logMessage :: String -> String
+logMessage msg = "[LOG] " ++ msg

tests/integration/tests/backpack-stale-cinst-consumer-change/files/impl-pkg/src/Str.hs

@@ -0,0 +1,4 @@
+module Str where
+
+greeting :: String
+greeting = "Hello from transitive chain"

tests/integration/tests/backpack-stale-cinst-consumer-change/files/logger-sig/package.yaml

@@ -0,0 +1,14 @@
+spec-version: 0.36.0
+
+name: logger-sig
+
+dependencies:
+- base
+
+library:
+  source-dirs: src
+  signatures: Logger
+  dependencies:
+  - name: str-sig
+    mixin:
+    - requires (Str as Str)

tests/integration/tests/backpack-stale-cinst-consumer-change/files/logger-sig/src/LogHelper.hs

@@ -0,0 +1,7 @@
+module LogHelper where
+
+import Str (greeting)
+import Logger (logMessage)
+
+greetWithLog :: String
+greetWithLog = logMessage greeting

tests/integration/tests/backpack-stale-cinst-consumer-change/files/logger-sig/src/Logger.hsig

@@ -0,0 +1,3 @@
+signature Logger where
+
+logMessage :: String -> String

tests/integration/tests/backpack-stale-cinst-consumer-change/files/stack.yaml

@@ -0,0 +1,7 @@
+snapshot: ghc-9.10.3
+
+packages:
+- consumer-pkg
+- impl-pkg
+- logger-sig
+- str-sig

tests/integration/tests/backpack-stale-cinst-consumer-change/files/str-sig/package.yaml

@@ -0,0 +1,11 @@
+spec-version: 0.36.0
+
+name: str-sig
+
+dependencies:
+- base
+
+library:
+  source-dirs: src
+  signatures:
+  - Str

tests/integration/tests/backpack-stale-cinst-consumer-change/files/str-sig/src/Str.hsig

@@ -0,0 +1,3 @@
+signature Str where
+
+greeting :: String