commit e716b1d4f8ccef21c1bb171e65e26e69af948673
Author: Coder Agent <coder@agents.omni>
Date: Mon Apr 20 12:28:31 2026
fix(bild): handle ambiguous ghc-pkg module providers
Parse ghc-pkg --simple-output as package tokens (not line blobs),
normalize cached entries, and prefer explicit : dep choices when
multiple packages provide the same module.
Task-Id: t-809
diff --git a/Omni/Bild.hs b/Omni/Bild.hs
index e8377faa..f369d44d 100755
--- a/Omni/Bild.hs
+++ b/Omni/Bild.hs
@@ -190,6 +190,8 @@ main = Cli.Plan parser test_ pure |> Cli.main
test_isGitHook,
test_detectPythonImports,
test_detectHaskellImports,
+ test_parseGhcPkgFindModuleOutput,
+ test_resolveGhcPkgCandidates,
test_buildHsModuleGraph
]
@@ -952,7 +954,8 @@ detectHaskellImports _ contentLines = do
(srcs, transitiveExtMods, transitiveDeps) <- bfs root initialLocalsSet Set.empty Set.empty entryLangDeps
let allExtMods = Set.fromList initialExternals <> transitiveExtMods
pkgSets <- Async.mapConcurrently ghcPkgFindModuleCached (Set.toList allExtMods)
- let pkgs = mconcat pkgSets <> transitiveDeps
+ let resolvedGhcPkgs = foldMap (resolveGhcPkgCandidates transitiveDeps) pkgSets
+ let pkgs = resolvedGhcPkgs <> transitiveDeps
pure (pkgs, srcs)
where
bfs :: FilePath -> Set FilePath -> Set FilePath -> Set String -> Set Meta.Dep -> IO (Set FilePath, Set String, Set Meta.Dep)
@@ -982,6 +985,13 @@ detectHaskellImports _ contentLines = do
let rels = map (Namespace.fromHaskellModule .> Namespace.toPath) mods
filterM (\rel -> Dir.doesFileExist (root </> rel)) rels
+resolveGhcPkgCandidates :: Set Meta.Dep -> Set Meta.Dep -> Set Meta.Dep
+resolveGhcPkgCandidates explicitDeps candidates
+ | Set.size candidates <= 1 = candidates
+ | otherwise =
+ let pinned = Set.intersection candidates explicitDeps
+ in Set.null pinned ?: (Set.empty, pinned)
+
resolveLocalHaskellDep :: FilePath -> Meta.Dep -> IO (Maybe FilePath)
resolveLocalHaskellDep root dep = do
let normalized = fromMaybe dep (List.stripPrefix "./" dep)
@@ -1103,6 +1113,37 @@ test_detectHaskellImports =
Set.member depRelPath srcs @=? True
Set.member "sqlite-simple" langdeps @=? True
+test_parseGhcPkgFindModuleOutput :: Test.Tree
+test_parseGhcPkgFindModuleOutput =
+ Test.group
+ "parseGhcPkgFindModuleOutput"
+ [ Test.unit "splits simple-output package list" <| do
+ parseGhcPkgFindModuleOutput "base64 base64-bytestring\n"
+ @=? Set.fromList ["base64", "base64-bytestring"],
+ Test.unit "normalizes cached package names containing spaces" <| do
+ cacheFromDisk (Map.fromList [("Data.ByteString.Base64", ["base64 base64-bytestring"])])
+ @=? Map.fromList [("Data.ByteString.Base64", Set.fromList ["base64", "base64-bytestring"])]
+ ]
+
+test_resolveGhcPkgCandidates :: Test.Tree
+test_resolveGhcPkgCandidates =
+ Test.group
+ "resolveGhcPkgCandidates"
+ [ Test.unit "keeps singleton candidate set" <| do
+ resolveGhcPkgCandidates Set.empty (Set.fromList ["text"])
+ @=? Set.fromList ["text"],
+ Test.unit "prefers explicit dep for ambiguous module providers" <| do
+ resolveGhcPkgCandidates
+ (Set.fromList ["base64-bytestring"])
+ (Set.fromList ["base64", "base64-bytestring"])
+ @=? Set.fromList ["base64-bytestring"],
+ Test.unit "drops ambiguous candidates when no explicit dep exists" <| do
+ resolveGhcPkgCandidates
+ Set.empty
+ (Set.fromList ["base64", "base64-bytestring"])
+ @=? Set.empty
+ ]
+
test_buildHsModuleGraph :: Test.Tree
test_buildHsModuleGraph =
Test.group
@@ -1134,7 +1175,7 @@ cacheToDisk cache =
cacheFromDisk :: GhcPkgCacheDisk -> GhcPkgCacheMem
cacheFromDisk cache =
- Map.map Set.fromList <| Map.filter (not <. null) cache
+ Map.map (Set.fromList <. normalizePkgNames) <| Map.filter (not <. null) cache
ghcPkgCacheHash :: IO (Maybe String)
ghcPkgCacheHash = do
@@ -1212,7 +1253,13 @@ ghcPkgFindModule acc m =
"ghc-pkg"
["--package-db", packageDb, "--names-only", "--simple-output", "find-module", m]
""
- pure (Set.union acc (Set.fromList (String.lines out)))
+ pure (Set.union acc (parseGhcPkgFindModuleOutput out))
+
+parseGhcPkgFindModuleOutput :: String -> Set String
+parseGhcPkgFindModuleOutput = Set.fromList <. normalizePkgNames <. String.lines
+
+normalizePkgNames :: [String] -> [String]
+normalizePkgNames = concatMap String.words
-- | Build module graph for Haskell targets, returns Nothing if TH or cycles detected
buildHsModuleGraph :: Namespace -> FilePath -> Set FilePath -> IO (Maybe HsModuleGraph)