@@ -1,3 +1,4 @@
1+{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE AllowAmbiguousTypes #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleContexts #-}
@@ -28,10 +29,11 @@ module Data.Generics.Product.Param
2829 , HasParam (..)
2930 ) where
3031
31−import GHC.TypeLits (Nat)
32+import GHC.TypeLits
3233import Data.Generics.Internal.Void
3334import Data.Generics.Internal.Families.Changing
3435import Data.Generics.Internal.VL.Traversal
36+import Data.Generics.Internal.VL.Lens
3537
3638import GHC.Generics
3739import Data.Kind
@@ -47,12 +49,27 @@ instance
4749 -- TODO: merge the old 'Changing' code with 'GenericN'
4850 , s ~ Infer t (P n b 'PTag) a
4951 , t ~ Infer s (P n a 'PTag) b
52+ , Error ((ArgCount s) <=? n) n (ArgCount s) s
5053 , GHasParam n (RepN s) (RepN t) a b
5154 ) => HasParam n s t a b where
5255
5356 param = confusing (\f s -> toN <$> gparam @n f (fromN s))
5457 {-# INLINE param #-}
5558
59+type family Error (b :: Bool) (expected :: Nat) (actual :: Nat) (s :: Type) :: Constraint where
60+ Error 'False _ _ _
61+ = ()
62+
63+ Error 'True expected actual typ
64+ = TypeError
65+ ( 'Text "Expected a type with at least "
66+ ':<>: 'ShowType (expected + 1)
67+ ':<>: 'Text " parameters, but "
68+ ':$$: 'ShowType typ
69+ ':<>: 'Text " only has "
70+ ':<>: 'ShowType actual
71+ )
72+
5673instance {-# OVERLAPPING #-} HasParam p (Void1 a) (Void1 b) a b where
5774 param = undefined
5875