[Backpack]: improve the error message in case of a mutually recursive unit (#8582)

* [Backpack]: improve the error message in case of a mutually recursive unit during unification.

* Review fix: remove either, fail in UnifyM

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Cabal/src/Distribution/Backpack/LinkedComponent.hs

@@ -210,12 +210,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
         -- Read out all the final results by converting back
         -- into a pure representation.
         let convertIncludeU (ComponentInclude dep_aid rns i) = do
-                uid <- convertUnitIdU (ann_id dep_aid)
+                let component_name = pretty $ ann_cname dep_aid
+                uid <- convertUnitIdU (ann_id dep_aid) component_name
                 return (ComponentInclude {
-                            ci_ann_id = dep_aid { ann_id = uid },
-                            ci_renaming = rns,
-                            ci_implicit = i
-                        })
+                        ci_ann_id = dep_aid { ann_id = uid },
+                        ci_renaming = rns,
+                        ci_implicit = i
+                    })
+
         shape <- convertModuleScopeU shape_u
         let (includes_u, sig_includes_u) = partitionEithers all_includes_u
         incls <- traverse convertIncludeU includes_u

Cabal/src/Distribution/Backpack/UnifyM.hs

@@ -386,19 +386,21 @@ lookupMooEnv (m, i) k =
 
 -- The workhorse functions
 
-convertUnitIdU' :: MooEnv -> UnitIdU s -> UnifyM s OpenUnitId
-convertUnitIdU' stk uid_u = do
+-- | Returns `OpenUnitId` if there is no a mutually recursive unit.
+-- | Otherwise returns a list of signatures instantiated by given `UnitIdU`.
+convertUnitIdU' :: MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
+convertUnitIdU' stk uid_u required_mod_name = do
     x <- liftST $ UnionFind.find uid_u
     case x of
-        UnitIdThunkU uid -> return (DefiniteUnitId uid)
+        UnitIdThunkU uid -> return $ DefiniteUnitId uid
         UnitIdU u cid insts_u ->
             case lookupMooEnv stk u of
-                Just _i ->
-                    failWith (text "Unsupported mutually recursive unit identifier")
-                    -- return (UnitIdVar i)
+                Just _ ->
+                    let mod_names = Map.keys insts_u
+                    in failWithMutuallyRecursiveUnitsError required_mod_name mod_names
                 Nothing -> do
                     insts <- for insts_u $ convertModuleU' (extendMooEnv stk u)
-                    return (IndefFullUnitId cid insts)
+                    return $ IndefFullUnitId cid insts
 
 convertModuleU' :: MooEnv -> ModuleU s -> UnifyM s OpenModule
 convertModuleU' stk mod_u = do
@@ -406,12 +408,20 @@ convertModuleU' stk mod_u = do
     case mod of
         ModuleVarU mod_name -> return (OpenModuleVar mod_name)
         ModuleU uid_u mod_name -> do
-            uid <- convertUnitIdU' stk uid_u
+            uid <- convertUnitIdU' stk uid_u (pretty mod_name)
             return (OpenModule uid mod_name)
 
+failWithMutuallyRecursiveUnitsError :: Doc -> [ModuleName] -> UnifyM s a
+failWithMutuallyRecursiveUnitsError required_mod_name mod_names =
+    let sigsList = hcat $ punctuate (text ", ") $ map (quotes . pretty) mod_names in
+    failWith $
+        text "Cannot instantiate requirement" <+> quotes required_mod_name $$
+        text "Ensure \"build-depends:\" doesn't include any library with signatures:" <+> sigsList $$
+        text "as this creates a cyclic dependency, which GHC does not support."
+
 -- Helper functions
 
-convertUnitIdU :: UnitIdU s -> UnifyM s OpenUnitId
+convertUnitIdU :: UnitIdU s -> Doc -> UnifyM s OpenUnitId
 convertUnitIdU = convertUnitIdU' emptyMooEnv
 
 convertModuleU :: ModuleU s -> UnifyM s OpenModule

cabal-testsuite/PackageTests/Backpack/T8582/Main.hs

+module Main where
+main = return ()

cabal-testsuite/PackageTests/Backpack/T8582/T8582.cabal

+name: T8582
+version: 1.0
+build-type: Simple
+cabal-version: 2.0
+
+library sig
+    default-language: Haskell2010
+    hs-source-dirs: sig
+    signatures: A
+    build-depends: base
+
+library impl
+    default-language: Haskell2010
+    hs-source-dirs: impl
+    exposed-modules: ImplA
+    reexported-modules: ImplA as A
+    build-depends: base, sig
+
+executable exe
+    default-language: Haskell2010
+    main-is: Main.hs
+    build-depends: base, impl, sig

cabal-testsuite/PackageTests/Backpack/T8582/cabal.project

+packages: .

cabal-testsuite/PackageTests/Backpack/T8582/impl/ImplA.hs

+module ImplA where

cabal-testsuite/PackageTests/Backpack/T8582/setup.cabal.out

+# Setup configure
+Configuring T8582-1.0...
+Error:
+    Cannot instantiate requirement 'ImplA'
+    Ensure "build-depends:" doesn't include any library with signatures: 'A'
+    as this creates a cyclic dependency, which GHC does not support.
+    In the stanza executable exe
\ No newline at end of file

cabal-testsuite/PackageTests/Backpack/T8582/setup.out

+# Setup configure
+Configuring T8582-1.0...
+Error:
+    Cannot instantiate requirement 'ImplA'
+    Ensure "build-depends:" doesn't include any library with signatures: 'A'
+    as this creates a cyclic dependency, which GHC does not support.
+    In the stanza executable exe
\ No newline at end of file

cabal-testsuite/PackageTests/Backpack/T8582/setup.test.hs

+import Test.Cabal.Prelude
+main = setupAndCabalTest $ do
+    skipUnlessGhcVersion ">= 8.1"
+    fails $ setup "configure" []

cabal-testsuite/PackageTests/Backpack/T8582/sig/A.sig

+signature A where

changelog.d/pr-8582

+synopsis: Improve mutually recursive unit identifier error message
+packages: Cabal
+prs: #8582
+description: {
+Improves the error message in case of mutually recursive unit identifiers
+by specifying the name of the identifier, the name of the signature, and a suggestion
+to check the 'build-depends:' section.
+}