@@ -50,7 +50,9 @@ import Data.Int (Int8, Int16, Int32, Int64)
5050import Data.Word (Word, Word8, Word16, Word32, Word64)
5151
5252import GHC.Generics
53+import GHC.TypeLits
5354import Data.Generics.Internal.VL.Traversal
55+import Data.Generics.Internal.Errors
5456
5557-- $setup
5658-- == /Running example:/
@@ -131,7 +133,9 @@ instance {-# OVERLAPPING #-} HasTypesUsing ch s Void where
131133-- >>> myTree = WithWeight (Fork (Leaf (Opaque "foo")) (Leaf (Opaque "bar"))) False
132134-- >>> over (types @String) (++ "!") myTree
133135-- ...
134−-- ... No instance for (HasTypesOpt
136+-- ... | No instance for ‘Generic Opaque’
137+-- ... | arising from a generic traversal.
138+-- ... | Either derive the instance, or define a custom traversal using ‘HasTypesCustom’
135139-- ...
136140--
137141-- In these cases, we can define a custom traversal strategy to override the
@@ -204,6 +208,13 @@ class HasTypesCustom (ch :: Type) s a where
204208instance {-# OVERLAPPABLE #-}
205209 ( GHasTypes ch (Rep s) a
206210 , Generic s
211+ -- if there's no Generic instance here, it means we got through the
212+ -- Children check by a user-defined custom strategy.
213+ -- Therefore, we can ignore the missing Generic instance, and
214+ -- instead report a missing HasTypesCustom instance
215+ , Defined (Rep s)
216+ (PrettyError '[ 'Text "No instance " ':<>: QuoteType (HasTypesCustom ch s a)])
217+ (() :: Constraint)
207218 ) => HasTypesCustom ch s a where
208219 typesCustom f s = to <$> gtypes_ @ch f (from s)
209220 --{-# INLINE types' #-}
@@ -230,7 +241,13 @@ type family ChildrenDefault (a :: Type) :: [Type] where
230241 ChildrenDefault Word16 = '[]
231242 ChildrenDefault Word32 = '[]
232243 ChildrenDefault Word64 = '[]
233− ChildrenDefault a = ChildrenGeneric (Rep a) '[]
244+ ChildrenDefault a
245+ = Defined (Rep a)
246+ (NoGeneric a
247+ '[ 'Text "arising from a generic traversal."
248+ , 'Text "Either derive the instance, or define a custom traversal using " ':<>: QuoteType HasTypesCustom
249+ ])
250+ (ChildrenGeneric (Rep a) '[])
234251
235252type family ChildrenGeneric (f :: k -> Type) (cs :: [Type]) :: [Type] where
236253 ChildrenGeneric (M1 _ _ f) cs = ChildrenGeneric f cs
@@ -303,7 +320,16 @@ instance GHasTypes ch V1 a where
303320 {-# INLINE gtypes_ #-}
304321
305322type Interesting (ch :: Type) (a :: Type) (t :: Type)
306− = IsNothing (Interesting' ch a '[t] (Children ch t))
323+ = Defined_list (Children ch t) (NoChildren ch t)
324+ (IsNothing (Interesting' ch a '[t] (Children ch t)))
325+
326+type family NoChildren (ch :: Type) (a :: Type) :: Constraint where
327+ NoChildren ch a = PrettyError
328+ '[ 'Text "No type family instance for " ':<>: QuoteType (Children ch a)
329+ , 'Text "arising from a traversal over " ':<>: QuoteType a
330+ , 'Text "with custom strategy " ':<>: QuoteType ch
331+ ]
332+
307333
308334type family Interesting' (ch :: Type) (a :: Type) (seen :: [Type]) (ts :: [Type]) :: Maybe [Type] where
309335 Interesting' ch _ seen '[] = 'Just seen
@@ -317,7 +343,9 @@ type family InterestingUnless
317343 Maybe [Type] where
318344 InterestingUnless ch a seen a _ = 'Nothing
319345 InterestingUnless ch a seen t 'True = 'Just seen
320− InterestingUnless ch a seen t 'False = Interesting' ch a (t ': seen) (Children ch t)
346+ InterestingUnless ch a seen t 'False
347+ = Defined_list (Children ch t) (NoChildren ch t)
348+ (Interesting' ch a (t ': seen) (Children ch t))
321349
322350-- Short circuit
323351type family InterestingOr