on master help sign in
Better type errors for `_Ctor` and `_Typed` prisms
commit8e29cd107fec6639576f0b4a2a00d2767e8af239 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateMon 14 Jan 2019, 16:47 (8 years ago) parentb86939f
2 files changed+20−7
src/Data/Generics/Sum/Constructors.hs+16−7 src/Data/Generics/Sum/Typed.hs+4
src/Data/Generics/Sum/Constructors.hs+16−7
@@ -45,6 +45,7 @@ import GHC.TypeLits (Symbol, TypeError, ErrorMessage (..))
4545import Data.Generics.Internal.VL.Prism
4646import Data.Generics.Internal.Profunctor.Iso
4747import Data.Generics.Internal.Profunctor.Prism (prismPRavel)
48+import Data.Generics.Internal.Errors
4849
4950-- $setup
5051-- == /Running example:/
@@ -70,7 +71,7 @@ import Data.Generics.Internal.Profunctor.Prism (prismPRavel)
7071-- , age :: Age
7172-- , fieldA :: a
7273-- }
73−-- deriving (Generic, Show)
74+-- deriving Show
7475-- type Name = String
7576-- type Age = Int
7677-- dog, cat, duck :: Animal Int
@@ -128,20 +129,24 @@ instance
128129 ( Generic s
129130 , ErrorUnless ctor s (HasCtorP ctor (Rep s))
130131 , GAsConstructor' ctor (Rep s) a
132+ , Defined (Rep s)
133+ (NoGeneric s '[ 'Text "arising from a generic prism focusing on the "
134+ ':<>: QuoteType ctor ':<>: 'Text " constructor of type " ':<>: QuoteType a
135+ , 'Text "in " ':<>: QuoteType s])
136+ (() :: Constraint)
131137 ) => AsConstructor' ctor s a where
132138 _Ctor' eta = prismRavel (prismPRavel (repIso . _GCtor @ctor)) eta
133139 {-# INLINE[2] _Ctor' #-}
134140
135141instance
136− ( Generic s
137− , Generic t
138− , ErrorUnless ctor s (HasCtorP ctor (Rep s))
142+ ( ErrorUnless ctor s (HasCtorP ctor (Rep s))
139143 , GAsConstructor' ctor (Rep s) a -- TODO: add a test similar to #62 for prisms
140144 , GAsConstructor' ctor (Rep (Indexed s)) a'
141145 , GAsConstructor ctor (Rep s) (Rep t) a b
142146 , t ~ Infer s a' b
143147 , GAsConstructor' ctor (Rep (Indexed t)) b'
144148 , s ~ Infer t b' a
149+ , AsConstructor0 ctor s t a b
145150 ) => AsConstructor ctor s t a b where
146151
147152 _Ctor = _Ctor0 @ctor
@@ -152,15 +157,14 @@ instance {-# OVERLAPPING #-} AsConstructor ctor (Void1 a) (Void1 b) a b where
152157 _Ctor = undefined
153158
154159instance
155− ( Generic s
156− , Generic t
157− , ErrorUnless ctor s (HasCtorP ctor (Rep s))
160+ ( ErrorUnless ctor s (HasCtorP ctor (Rep s))
158161 , GAsConstructor' ctor (Rep s) a -- TODO: add a test similar to #62 for prisms
159162 , GAsConstructor' ctor (Rep (Indexed s)) a'
160163 , GAsConstructor ctor (Rep s) (Rep t) a b
161164 , GAsConstructor' ctor (Rep (Indexed t)) b'
162165 , UnifyHead s t
163166 , UnifyHead t s
167+ , AsConstructor0 ctor s t a b
164168 ) => AsConstructor_ ctor s t a b where
165169
166170 _Ctor_ = _Ctor0 @ctor
@@ -173,6 +177,11 @@ instance
173177 ( Generic s
174178 , Generic t
175179 , GAsConstructor ctor (Rep s) (Rep t) a b
180+ , Defined (Rep s)
181+ (NoGeneric s '[ 'Text "arising from a generic prism focusing on the "
182+ ':<>: QuoteType ctor ':<>: 'Text " constructor of type " ':<>: QuoteType a
183+ , 'Text "in " ':<>: QuoteType s])
184+ (() :: Constraint)
176185 ) => AsConstructor0 ctor s t a b where
177186 _Ctor0 = prismRavel (prismPRavel (repIso . _GCtor @ctor))
178187 {-# INLINE[2] _Ctor0 #-}
src/Data/Generics/Sum/Typed.hs+4
@@ -34,6 +34,7 @@ import Data.Kind
3434import GHC.Generics
3535import GHC.TypeLits (TypeError, ErrorMessage (..), Symbol)
3636import Data.Generics.Sum.Internal.Typed
37+import Data.Generics.Internal.Errors
3738
3839import Data.Generics.Internal.Families
3940import Data.Generics.Internal.Void
@@ -109,6 +110,9 @@ instance
109110 , as ~ TupleToList a
110111 , ListTuple a as
111112 , GAsType (Rep s) as
113+ , Defined (Rep s)
114+ (NoGeneric s '[ 'Text "arising from a generic prism focusing on a constructor of type " ':<>: QuoteType a])
115+ (() :: Constraint)
112116 ) => AsType a s where
113117
114118 _Typed eta = prismRavel (prismPRavel (repIso . _GTyped @_ @as . tupled)) eta