constrained-generators: Improve some error messages

IntersectMBO · Oct 15, 2024 · 30992cb · 30992cb
1 parent 3cef69e
commit 30992cb
Showing 1 changed file with 15 additions and 13 deletions.
diff --git a/libs/constrained-generators/src/Constrained/Base.hs b/libs/constrained-generators/src/Constrained/Base.hs
@@ -653,12 +653,17 @@ instance HasSpec fn a => Semigroup (Specification fn a) where
       $ MemberSpec
       $ nub
       $ intersect as as'
-  MemberSpec as <> TypeSpec s cant =
-    MemberSpec $
-      nub $
-        filter
-          (flip (conformsTo @fn) s)
-          (filter (`notElem` cant) as)
+  ms@(MemberSpec as) <> ts@TypeSpec {} =
+    case nub $ filter (`conformsToSpec` ts) as of
+      [] ->
+        ErrorSpec
+          ( NE.fromList
+              [ "The two " ++ show (typeRep (Proxy @a)) ++ " Specifications are inconsistent."
+              , "  " ++ show ms
+              , "  " ++ show ts
+              ]
+          )
+      as' -> MemberSpec as'
   TypeSpec s cant <> MemberSpec as = MemberSpec as <> TypeSpec s cant
   SuspendedSpec v p <> SuspendedSpec v' p' = SuspendedSpec v (p <> rename v' v p')
   SuspendedSpec v ps <> s = SuspendedSpec v (ps <> satisfies (V v) s)
@@ -1094,8 +1099,7 @@ genFromSpecT (simplifySpec -> spec) = case spec of
     explain
       ( NE.fromList
           [ ""
-          , "genFromSpecT"
-          , "    " ++ show (typeRep cant)
+          , "genFromSpecT at type " ++ show (typeRep cant)
           , "    " ++ show spec
           , "  with mode " ++ show mode
           ]
@@ -1104,7 +1108,7 @@ genFromSpecT (simplifySpec -> spec) = case spec of
       -- TODO: we could consider giving `cant` as an argument to `genFromTypeSpec` if this
       -- starts giving us trouble.
       genFromTypeSpec @fn s `suchThatT` (`notElem` cant)
-  ErrorSpec e -> explain1 "genFromSpecT ErrorSpec{} with explanation:" $ genError e
+  ErrorSpec e -> genError e
 
 shrinkWithSpec :: forall fn a. HasSpec fn a => Specification fn a -> a -> [a]
 -- TODO: possibly allow for ignoring the `conformsToSpec` check in the `TypeSpec`
@@ -1297,11 +1301,9 @@ mergeSolverStage (SolverStage x ps spec) plan =
               ( NE.fromList
                   ( [ "Solving var " ++ show x ++ " fails."
                     , "Merging the Specs"
-                    , "   " ++ show spec
-                    , "   " ++ show spec'
-                    , "Predicates"
+                    , "   1. " ++ show spec
+                    , "   2. " ++ show spec'
                     ]
-                      ++ (map show (ps ++ ps'))
                   )
               )
               (spec <> spec')