{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Generics.Product.Constraints
(
HasConstraints (..)
, HasConstraints' (..)
) where
import Data.Generics.Product.Internal.Constraints
import Data.Kind (Constraint)
import GHC.Generics (Generic (Rep), from, to)
import Data.Generics.Internal.VL.Traversal
class HasConstraints' (c :: * -> Constraint) s where
constraints' :: TraversalC' c s
instance
( Generic s
, GHasConstraints' c (Rep s)
) => HasConstraints' c s where
constraints' :: (forall a. c a => a -> f a) -> s -> f s
constraints' = TraversalC' c s -> (forall a. c a => a -> f a) -> s -> f s
forall (c :: * -> Constraint) (f :: * -> *) s.
Applicative f =>
TraversalC' c s -> LensLikeC c f s
confusingC @c (\f :: forall a. c a => a -> f a
f s :: s
s -> Rep s Any -> s
forall a x. Generic a => Rep a x -> a
to (Rep s Any -> s) -> f (Rep s Any) -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. c a => a -> f a) -> Rep s Any -> f (Rep s Any)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *) x.
(GHasConstraints' c f, Applicative g) =>
(forall a. c a => a -> g a) -> f x -> g (f x)
gconstraints' @c forall a. c a => a -> f a
f (s -> Rep s Any
forall a x. Generic a => a -> Rep a x
from s
s))
{-# INLINE constraints' #-}
class HasConstraints (c :: * -> * -> Constraint) s t where
constraints :: TraversalC c s t
instance
( Generic s
, Generic t
, GHasConstraints c (Rep s) (Rep t)
) => HasConstraints c s t where
constraints :: (forall a b. c a b => a -> f b) -> s -> f t
constraints f :: forall a b. c a b => a -> f b
f s :: s
s = Rep t Any -> t
forall a x. Generic a => Rep a x -> a
to (Rep t Any -> t) -> f (Rep t Any) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. c a b => a -> f b) -> Rep s Any -> f (Rep t Any)
forall (c :: * -> * -> Constraint) (s :: * -> *) (t :: * -> *) x.
GHasConstraints c s t =>
TraversalC c (s x) (t x)
gconstraints @c forall a b. c a b => a -> f b
f (s -> Rep s Any
forall a x. Generic a => a -> Rep a x
from s
s)
{-# INLINE constraints #-}