{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE UndecidableInstances  #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Product.Constraints
-- Copyright   :  (C) 2019 Csongor Kiss
-- License     :  BSD3
-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Constrained traversals.
--
-----------------------------------------------------------------------------

module Data.Generics.Product.Constraints
  ( -- *Traversals
    --
    --  $example
    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 #-}