content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE DataKinds #-}
  
  module Data.Generics.Product.Internal.Param
    ( Context
    , derived
    ) where
  
  import Data.Generics.Product.Internal.Types
  import Data.Generics.Internal.VL.Traversal
  
  import GHC.Generics
  import Data.Kind
  import Data.Generics.Internal.Families
  import Data.Generics.Internal.GenericN
  import Data.Generics.Internal.Errors
  import GHC.TypeLits
  
  type Context n s t a b
    =  ( GenericN s
       , GenericN t
       -- TODO: merge the old 'Changing' code with 'GenericN'
       , Defined (Rep s)
         (NoGeneric s
           '[ 'Text "arising from a generic traversal of the type parameter at position " ':<>: QuoteType n
            , 'Text "of type " ':<>: QuoteType a ':<>: 'Text " in " ':<>: QuoteType s
            ])
         (() :: Constraint)
       , s ~ Infer t (P n b 'PTag) a
       , t ~ Infer s (P n a 'PTag) b
       , Error ((ArgCount s) <=? n) n (ArgCount s) s
       , a ~ ArgAt s n
       , b ~ ArgAt t n
       , GHasTypes ChGeneric (RepN s) (RepN t) (Param n a) (Param n b)
       )
  
  derived :: forall n s t a b. Context n s t a b => Traversal s t a b
  derived = repIsoN . gtypes_ @ChGeneric . paramIso @n
  
  -- this could be an iso but since we're operating on a VL traversal it's easier this way.
  repIsoN :: (GenericN a, GenericN b) => Traversal a b (RepN a x) (RepN b x)
  repIsoN f a = toN <$> f (fromN a)
  
  -- this could be an iso but since we're operating on a VL traversal it's easier this way.
  paramIso :: Traversal (Param n a) (Param n b) a b
  paramIso f a = StarParam <$> f (getStarParam a)
  
  type family Error (b :: Bool) (expected :: Nat) (actual :: Nat) (s :: Type) :: Constraint where
    Error 'False _ _ _
      = ()
  
    Error 'True expected actual typ
      = TypeError
          (     'Text "Expected a type with at least "
          ':<>: 'ShowType (expected + 1)
          ':<>: 'Text " parameters, but "
          ':$$: 'ShowType typ
          ':<>: 'Text " only has "
          ':<>: 'ShowType actual
          )
  