Handle Backpack signature files in component discovery

Treat declared .hsig files as Backpack signatures instead of unknown custom-preprocessor candidates. Track declared signature files for rebuilds, keep signature modules out of ordinary module resolution, and emit a Backpack-specific warning when a local .hsig file is not listed in the component's signatures field.

Keep the existing custom-preprocessor warning for other unknown extensions.

Author: philippedev101

src/Stack/ComponentFile.hs

@@ -41,8 +41,8 @@ import qualified Distribution.Utils.Path as Cabal
 import           GHC.Records ( HasField )
 import qualified HiFileParser as Iface
 import           Path
-                   ( (</>), filename, isProperPrefixOf, parent, parseRelDir
-                   , stripProperPrefix
+                   ( (</>), fileExtension, filename, isProperPrefixOf, parent
+                   , parseRelDir, stripProperPrefix
                    )
 import           Path.Extra
                    ( forgivingResolveDir, forgivingResolveFile
@@ -84,7 +84,7 @@ stackBenchmarkFiles ::
      StackBenchmark
   -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
 stackBenchmarkFiles bench =
-  resolveComponentFiles (CBench bench.name) build names
+  resolveComponentFiles (CBench bench.name) build names []
  where
   names :: [DotCabalDescriptor]
   names = bnames <> exposed
@@ -106,7 +106,7 @@ stackTestSuiteFiles ::
      StackTestSuite
   -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
 stackTestSuiteFiles test =
-  resolveComponentFiles (CTest test.name) build names
+  resolveComponentFiles (CTest test.name) build names []
  where
   names :: [DotCabalDescriptor]
   names = bnames <> exposed
@@ -129,7 +129,7 @@ stackExecutableFiles ::
      StackExecutable
   -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
 stackExecutableFiles exe =
-  resolveComponentFiles (CExe exe.name) build names
+  resolveComponentFiles (CExe exe.name) build names []
  where
   build :: StackBuildInfo
   build = exe.buildInfo
@@ -144,7 +144,7 @@ stackLibraryFiles ::
      StackLibrary
   -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
 stackLibraryFiles lib =
-  resolveComponentFiles componentName build names
+  resolveComponentFiles componentName build names lib.signatures
  where
   componentRawName :: StackUnqualCompName
   componentRawName = lib.name
@@ -174,18 +174,22 @@ resolveComponentFiles ::
   => NamedComponent
   -> rec
   -> [DotCabalDescriptor]
+  -> [ModuleName]
   -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
-resolveComponentFiles component build names = do
+resolveComponentFiles component build names signatureNames = do
   dirs <- mapMaybeM (resolveDirOrWarn . getSymbolicPath) build.hsSourceDirs
   dir <- asks (parent . (.file))
   agdirs <- autogenDirs
+  let allDirs = (if null dirs then [dir] else dirs) ++ agdirs
   (modules,files,warnings) <-
     resolveFilesAndDeps
       component
-      ((if null dirs then [dir] else dirs) ++ agdirs)
+      allDirs
       names
+      (S.fromList signatureNames)
+  sigFiles <- resolveSignatureFiles allDirs signatureNames
   cfiles <- buildOtherSources build
-  pure (component, ComponentFile modules (files <> cfiles) warnings)
+  pure (component, ComponentFile modules (files <> sigFiles <> cfiles) warnings)
  where
   autogenDirs :: RIO GetPackageFileContext [Path Abs Dir]
   autogenDirs = do
@@ -201,11 +205,13 @@ resolveFilesAndDeps ::
      NamedComponent       -- ^ Package component name
   -> [Path Abs Dir]       -- ^ Directories to look in.
   -> [DotCabalDescriptor] -- ^ Base names.
+  -> Set ModuleName       -- ^ Backpack signatures already accounted for.
   -> RIO
        GetPackageFileContext
        (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-resolveFilesAndDeps component dirs names0 = do
-  (dotCabalPaths, foundModules, missingModules, _) <- loop names0 S.empty M.empty
+resolveFilesAndDeps component dirs names0 signatureModules = do
+  (dotCabalPaths, foundModules, missingModules, _) <-
+    loop names0 signatureModules M.empty
   warnings <-
     liftM2 (++) (warnUnlisted foundModules) (warnMissing missingModules)
   pure (foundModules, dotCabalPaths, warnings)
@@ -224,7 +230,7 @@ resolveFilesAndDeps component dirs names0 = do
          )
   loop [] _ _ = pure ([], M.empty, [], M.empty)
   loop names doneModules0 knownUsages = do
-    resolved <- resolveFiles dirs names
+    resolved <- resolveFiles dirs signatureModules names
     let foundFiles = mapMaybe snd resolved
         foundModules = mapMaybe toResolvedModule resolved
         missingModules = mapMaybe toMissingModule resolved
@@ -289,6 +295,22 @@ resolveFilesAndDeps component dirs names0 = do
   toMissingModule _ =
     Nothing
 
+-- | Resolve Backpack signature files declared by a library component. Signature
+-- files are tracked for rebuilds, but they are not ordinary implementation
+-- modules and should not feed unlisted-module warnings.
+resolveSignatureFiles ::
+     [Path Abs Dir]
+  -> [ModuleName]
+  -> RIO GetPackageFileContext [DotCabalPath]
+resolveSignatureFiles dirs =
+  fmap concat . mapM resolveSignatureFile
+ where
+  resolveSignatureFile mn = do
+    let relFile = Cabal.toFilePath mn ++ ".hsig"
+    matches <- fmap (nubOrd . catMaybes) $
+      mapM (\dir -> resolveDirFile dir relFile) dirs
+    pure $ map DotCabalFilePath matches
+
 -- | Get the dependencies of a Haskell module file.
 getDependencies ::
      Map FilePath (Path Abs File)
@@ -385,28 +407,33 @@ componentOutputDir namedComponent distDir =
 -- extensions.
 resolveFiles ::
      [Path Abs Dir] -- ^ Directories to look in.
+  -> Set ModuleName -- ^ Backpack signatures declared by the component.
   -> [DotCabalDescriptor] -- ^ Base names.
   -> RIO GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
-resolveFiles dirs names =
-  forM names (\name -> fmap (name, ) (findCandidate dirs name))
+resolveFiles dirs signatureModules names =
+  forM names (\name -> fmap (name, ) (findCandidate dirs signatureModules name))
 
 -- | Find a candidate for the given module-or-filename from the list
 -- of directories and given extensions.
 findCandidate ::
      [Path Abs Dir]
+  -> Set ModuleName
   -> DotCabalDescriptor
   -> RIO GetPackageFileContext (Maybe DotCabalPath)
-findCandidate dirs name = do
+findCandidate dirs signatureModules name = do
   pkg <- asks (.file) >>= parsePackageNameFromFilePath
   customPreprocessorExts <- view $ configL . to (.customPreprocessorExts)
   let haskellPreprocessorExts =
-        haskellDefaultPreprocessorExts ++ customPreprocessorExts
+        filter
+          (not . isBackpackSignatureExt)
+          (haskellDefaultPreprocessorExts ++ customPreprocessorExts)
   liftIO (makeNameCandidates haskellPreprocessorExts) >>= \case
     [candidate] -> pure (Just (cons candidate))
     [] -> do
       case name of
         DotCabalModule mn
-          | display mn /= paths_pkg pkg -> logPossibilities dirs mn
+          | display mn /= paths_pkg pkg ->
+              logPossibilities dirs signatureModules mn
         _ -> pure ()
       pure Nothing
     (candidate:rest) -> do
@@ -451,22 +478,39 @@ findCandidate dirs name = do
             (xs, ys) -> xs ++ ys
   resolveCandidate dir = fmap maybeToList . resolveDirFile dir
 
--- | Log that we couldn't find a candidate, but there are
--- possibilities for custom preprocessor extensions.
+isBackpackSignatureExt :: Text -> Bool
+isBackpackSignatureExt ext =
+  T.toLower (fromMaybe ext $ T.stripPrefix "." ext) == "hsig"
+
+isBackpackSignatureFile :: Path b File -> Bool
+isBackpackSignatureFile file =
+  maybe False (isBackpackSignatureExt . T.pack) $ fileExtension file
+
+-- | Log that we couldn't find a candidate, but there are possibilities for
+-- custom preprocessor extensions or an undeclared Backpack signature.
 --
 -- For example: .erb for a Ruby file might exist in one of the
 -- directories.
-logPossibilities :: HasTerm env => [Path Abs Dir] -> ModuleName -> RIO env ()
-logPossibilities dirs mn = do
+logPossibilities ::
+     HasTerm env
+  => [Path Abs Dir]
+  -> Set ModuleName
+  -> ModuleName
+  -> RIO env ()
+logPossibilities dirs signatureModules mn = do
   possibilities <- concat <$> makePossibilities
-  unless (null possibilities) $ prettyWarn $
+  let nonSignaturePossibilities =
+        filter (not . isBackpackSignatureFile) possibilities
+      signaturePossibilities =
+        filter isBackpackSignatureFile possibilities
+  unless (null nonSignaturePossibilities) $ prettyWarn $
        fillSep
          [ flow "Unable to find a known candidate for the Cabal entry"
          , (style Module . fromString $ display mn) <> ","
          , flow "but did find:"
          ]
     <> line
-    <> bulletedList (map pretty possibilities)
+    <> bulletedList (map pretty nonSignaturePossibilities)
     <> blankLine
     <> fillSep
          [ flow "If you are using a custom preprocessor for this module with \
@@ -476,6 +520,26 @@ logPossibilities dirs mn = do
          , flow "key in Stack's project-level configuration file"
          , "(" <> style File "stack.yaml" <> ")."
          ]
+  when
+    (mn `S.notMember` signatureModules && not (null signaturePossibilities))
+    $ prettyWarn
+    $    fillSep
+           [ flow "Found Backpack signature file for Cabal entry"
+           , (style Module . fromString $ display mn) <> ","
+           , flow "but that module is not listed in the component's"
+           , style Shell "signatures"
+           , flow "field:"
+           ]
+      <> line
+      <> bulletedList (map pretty signaturePossibilities)
+      <> blankLine
+      <> fillSep
+           [ flow "If this file is meant to be a Backpack signature, add"
+           , style Module (fromString $ display mn)
+           , flow "to the"
+           , style Shell "signatures"
+           , flow "field in the package description."
+           ]
  where
   makePossibilities = mapM makePossibility dirs
 

tests/integration/tests/backpack-undeclared-signature-warning/Main.hs

@@ -0,0 +1,23 @@
+-- Stack should explain likely Backpack signature mistakes with a Backpack
+-- warning, not the custom-preprocessor warning.
+
+import Control.Monad ( unless, when )
+import Data.List ( isInfixOf )
+import StackTest
+
+main :: IO ()
+main =
+  stackErrStderr ["build"] $ \err -> do
+    expect err "Found Backpack signature file for Cabal entry"
+    expect err "Logger"
+    expect err "not listed in the component's"
+    expect err "signatures"
+    when ("custom-preprocessor-extensions" `isInfixOf` err) $
+      error $
+           "Expected no custom-preprocessor warning for Logger.hsig, got: "
+        ++ show err
+
+expect :: String -> String -> IO ()
+expect err msg =
+  unless (msg `isInfixOf` err) $
+    error $ "Expected " ++ show msg ++ " in stderr, got: " ++ show err

tests/integration/tests/backpack-undeclared-signature-warning/files/.gitignore

@@ -0,0 +1 @@
+hsig-warning.cabal

tests/integration/tests/backpack-undeclared-signature-warning/files/package.yaml

@@ -0,0 +1,11 @@
+spec-version: 0.36.0
+
+name: hsig-warning
+
+dependencies:
+- base
+
+library:
+  source-dirs: src
+  exposed-modules: Lib
+  other-modules: Logger

tests/integration/tests/backpack-undeclared-signature-warning/files/src/Lib.hs

@@ -0,0 +1,4 @@
+module Lib where
+
+answer :: Int
+answer = 42

tests/integration/tests/backpack-undeclared-signature-warning/files/src/Logger.hsig

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

tests/integration/tests/backpack-undeclared-signature-warning/files/stack.yaml

@@ -0,0 +1 @@
+snapshot: ghc-9.10.3

tests/integration/tests/backpack-x-pkg-transitive/Main.hs

@@ -2,7 +2,7 @@
 -- sig: Logger) depends on str-sig (indefinite, sig: Str). When consumer mixes
 -- in logger-sig, both Logger and Str holes must be filled transitively.
 
-import Control.Monad ( unless )
+import Control.Monad ( unless, when )
 import Data.List ( isInfixOf )
 import StackTest
 
@@ -15,19 +15,31 @@ main = do
   -- 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"]
+  stackCheckStderr ["build"] expectNoCandidateWarning
 
   -- 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
 
+  appendFile "logger-sig/src/Logger.hsig" "\nloggerName :: String\n"
+
   -- Rebuild should succeed (no stale CInst state)
-  stack ["build"]
+  stackCheckStderr ["build"] $ \err -> do
+    expectNoCandidateWarning err
+    unless ("Compiling Logger[sig]" `isInfixOf` err) $
+      error $
+           "Expected Logger.hsig change to rebuild Logger[sig], got stderr: "
+        ++ show err
 
   -- Verify output still correct after rebuild
   stackCheckStdout ["exec", "consumer-demo"] $ \out ->
     unless ("[LOG] Hello from transitive chain" `isInfixOf` out) $
       error $ "Expected '[LOG] Hello from transitive chain' after rebuild, got: "
             ++ show out
+
+expectNoCandidateWarning :: String -> IO ()
+expectNoCandidateWarning err =
+  when ("Unable to find a known candidate for the Cabal entry" `isInfixOf` err) $
+    error $ "Unexpected known candidate warning in stderr: " ++ show err

tests/integration/tests/backpack-x-pkg-transitive/files/impl-pkg/src/Logger.hs

@@ -2,3 +2,6 @@ module Logger where
 
 logMessage :: String -> String
 logMessage msg = "[LOG] " ++ msg
+
+loggerName :: String
+loggerName = "transitive logger"

tests/integration/tests/custom-preprocessor-extension-warning/Main.hs

@@ -0,0 +1,19 @@
+-- Stack should still suggest custom-preprocessor-extensions for unknown
+-- non-Haskell module file extensions.
+
+import Control.Monad ( unless )
+import Data.List ( isInfixOf )
+import StackTest
+
+main :: IO ()
+main =
+  stackErrStderr ["build"] $ \err -> do
+    expect err "Unable to find a known candidate for the Cabal entry"
+    expect err "Generated"
+    expect err "Generated.foo"
+    expect err "custom-preprocessor-extensions"
+
+expect :: String -> String -> IO ()
+expect err msg =
+  unless (msg `isInfixOf` err) $
+    error $ "Expected " ++ show msg ++ " in stderr, got: " ++ show err