{-# LANGUAGE TypeInType #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Generics.Product.Positions
(
HasPosition (..)
, HasPosition' (..)
, HasPosition_ (..)
, HasPosition0 (..)
, getPosition
, setPosition
) where
import Data.Generics.Internal.VL.Lens as VL
import Data.Generics.Internal.Void
import Data.Generics.Internal.Families
import Data.Generics.Product.Internal.Positions
import Data.Generics.Product.Internal.GLens
import Data.Generics.Internal.Errors
import Data.Kind (Constraint, Type)
import Data.Type.Bool (type (&&))
import GHC.Generics
import GHC.TypeLits (type (<=?), Nat, TypeError, ErrorMessage(..))
import Data.Generics.Internal.Profunctor.Lens as P
import Data.Coerce
class HasPosition (i :: Nat) s t a b | s i -> a, t i -> b, s i b -> t, t i a -> s where
position :: VL.Lens s t a b
class HasPosition_ (i :: Nat) s t a b where
position_ :: VL.Lens s t a b
class HasPosition' (i :: Nat) s a | s i -> a where
position' :: VL.Lens s s a a
class HasPosition0 (i :: Nat) s t a b where
position0 :: VL.Lens s t a b
getPosition :: forall i s a. HasPosition' i s a => s -> a
getPosition :: s -> a
getPosition s :: s
s = s
s s -> ((a -> Const a a) -> s -> Const a s) -> a
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall s a. HasPosition' i s a => Lens s s a a
forall (i :: Nat) s a. HasPosition' i s a => Lens s s a a
position' @i
setPosition :: forall i s a. HasPosition' i s a => a -> s -> s
setPosition :: a -> s -> s
setPosition = Lens s s a a -> a -> s -> s
forall s t a b. Lens s t a b -> b -> s -> t
VL.set (forall s a. HasPosition' i s a => Lens s s a a
forall (i :: Nat) s a. HasPosition' i s a => Lens s s a a
position' @i)
instance
( Generic s
, ErrorUnless i s (0 <? i && i <=? Size (Rep s))
, cs ~ CRep s
, Coercible (Rep s) cs
, GLens' (HasTotalPositionPSym i) cs a
, Defined (Rep s)
(NoGeneric s '[ 'Text "arising from a generic lens focusing on the field at"
, 'Text "position " ':<>: QuoteType i ':<>: 'Text " of type " ':<>: QuoteType a
':<>: 'Text " in " ':<>: QuoteType s
])
(() :: Constraint)
) => HasPosition' i s a where
position' :: (a -> f a) -> s -> f s
position' f :: a -> f a
f s :: s
s = (ALens a a a a -> ALens a a s s) -> (a -> f a) -> s -> f s
forall a b s t. (ALens a b a b -> ALens a b s t) -> Lens s t a b
VL.ravel (ALens a a (Rep s Any) (Rep s Any) -> ALens a a s s
forall a b x.
(Generic a, Generic b) =>
Lens a b (Rep a x) (Rep b x)
repLens (ALens a a (Rep s Any) (Rep s Any) -> ALens a a s s)
-> (ALens a a a a -> ALens a a (Rep s Any) (Rep s Any))
-> ALens a a a a
-> ALens a a s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (s :: k -> *) (t :: k -> *) (s' :: k -> *) (t' :: k -> *)
(x :: k) a b.
(Coercible t t', Coercible s s') =>
ALens a b (s x) (t x) -> ALens a b (s' x) (t' x)
forall (s' :: * -> *) (t' :: * -> *) x a b.
(Coercible cs t', Coercible cs s') =>
ALens a b (cs x) (cs x) -> ALens a b (s' x) (t' x)
coerced @cs @cs (ALens a a (cs Any) (cs Any) -> ALens a a (Rep s Any) (Rep s Any))
-> (ALens a a a a -> ALens a a (cs Any) (cs Any))
-> ALens a a a a
-> ALens a a (Rep s Any) (Rep s Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) (t :: * -> *) a b x.
GLens (HasTotalPositionPSym i) s t a b =>
Lens (s x) (t x) a b
forall (pred :: Pred) (s :: * -> *) (t :: * -> *) a b x.
GLens pred s t a b =>
Lens (s x) (t x) a b
glens @(HasTotalPositionPSym i)) a -> f a
f s
s
{-# INLINE position' #-}
class (~~) (a :: k) (b :: k) | a -> b, b -> a
instance (a ~ b) => (~~) a b
instance
( ErrorUnless i s (0 <? i && i <=? Size (Rep s))
, HasTotalPositionP i (CRep s) ~~ 'Just a
, HasTotalPositionP i (CRep t) ~~ 'Just b
, HasTotalPositionP i (CRep (Indexed s)) ~~ 'Just a'
, HasTotalPositionP i (CRep (Indexed t)) ~~ 'Just b'
, t ~~ Infer s a' b
, s ~~ Infer t b' a
, Coercible (CRep s) (Rep s)
, Coercible (CRep t) (Rep t)
, HasPosition0 i s t a b
) => HasPosition i s t a b where
position :: (a -> f b) -> s -> f t
position = forall s t a b. HasPosition0 i s t a b => Lens s t a b
forall (i :: Nat) s t a b. HasPosition0 i s t a b => Lens s t a b
position0 @i
{-# INLINE position #-}
coerced :: forall s t s' t' x a b. (Coercible t t', Coercible s s')
=> P.ALens a b (s x) (t x) -> P.ALens a b (s' x) (t' x)
coerced :: ALens a b (s x) (t x) -> ALens a b (s' x) (t' x)
coerced = ALens a b (s x) (t x) -> ALens a b (s' x) (t' x)
forall a b. Coercible a b => a -> b
coerce
{-# INLINE coerced #-}
#if __GLASGOW_HASKELL__ < 804
#else
#endif
instance {-# OVERLAPPING #-} HasPosition f (Void1 a) (Void1 b) a b where
position :: (a -> f b) -> Void1 a -> f (Void1 b)
position = (a -> f b) -> Void1 a -> f (Void1 b)
forall a. HasCallStack => a
undefined
instance
( ErrorUnless i s (0 <? i && i <=? Size (Rep s))
, UnifyHead s t
, UnifyHead t s
, Coercible (CRep s) (Rep s)
, Coercible (CRep t) (Rep t)
, HasPosition0 i s t a b
) => HasPosition_ i s t a b where
position_ :: (a -> f b) -> s -> f t
position_ = forall s t a b. HasPosition0 i s t a b => Lens s t a b
forall (i :: Nat) s t a b. HasPosition0 i s t a b => Lens s t a b
position0 @i
{-# INLINE position_ #-}
instance {-# OVERLAPPING #-} HasPosition_ f (Void1 a) (Void1 b) a b where
position_ :: (a -> f b) -> Void1 a -> f (Void1 b)
position_ = (a -> f b) -> Void1 a -> f (Void1 b)
forall a. HasCallStack => a
undefined
instance
( Generic s
, Generic t
, GLens (HasTotalPositionPSym i) (CRep s) (CRep t) a b
, Coercible (CRep s) (Rep s)
, Coercible (CRep t) (Rep t)
, Defined (Rep s)
(NoGeneric s '[ 'Text "arising from a generic lens focusing on the field at"
, 'Text "position " ':<>: QuoteType i ':<>: 'Text " of type " ':<>: QuoteType a
':<>: 'Text " in " ':<>: QuoteType s
])
(() :: Constraint)
) => HasPosition0 i s t a b where
position0 :: (a -> f b) -> s -> f t
position0 = (ALens a b a b -> ALens a b s t) -> Lens s t a b
forall a b s t. (ALens a b a b -> ALens a b s t) -> Lens s t a b
VL.ravel (ALens a b (Rep s Any) (Rep t Any) -> ALens a b s t
forall a b x.
(Generic a, Generic b) =>
Lens a b (Rep a x) (Rep b x)
repLens (ALens a b (Rep s Any) (Rep t Any) -> ALens a b s t)
-> (ALens a b a b -> ALens a b (Rep s Any) (Rep t Any))
-> ALens a b a b
-> ALens a b s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (s :: k -> *) (t :: k -> *) (s' :: k -> *) (t' :: k -> *)
(x :: k) a b.
(Coercible t t', Coercible s s') =>
ALens a b (s x) (t x) -> ALens a b (s' x) (t' x)
forall (s' :: * -> *) (t' :: * -> *) x a b.
(Coercible (CRep t) t', Coercible (CRep s) s') =>
ALens a b (CRep s x) (CRep t x) -> ALens a b (s' x) (t' x)
coerced @(CRep s) @(CRep t) (ALens
a b (Fst (Traverse (Rep s) 1) Any) (Fst (Traverse (Rep t) 1) Any)
-> ALens a b (Rep s Any) (Rep t Any))
-> (ALens a b a b
-> ALens
a b (Fst (Traverse (Rep s) 1) Any) (Fst (Traverse (Rep t) 1) Any))
-> ALens a b a b
-> ALens a b (Rep s Any) (Rep t Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) (t :: * -> *) a b x.
GLens (HasTotalPositionPSym i) s t a b =>
Lens (s x) (t x) a b
forall (pred :: Pred) (s :: * -> *) (t :: * -> *) a b x.
GLens pred s t a b =>
Lens (s x) (t x) a b
glens @(HasTotalPositionPSym i))
{-# INLINE position0 #-}
type family ErrorUnless (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint where
ErrorUnless i s 'False
= TypeError
( 'Text "The type "
':<>: 'ShowType s
':<>: 'Text " does not contain a field at position "
':<>: 'ShowType i
)
ErrorUnless _ _ 'True
= ()
data HasTotalPositionPSym :: Nat -> (TyFun (Type -> Type) (Maybe Type))
type instance Eval (HasTotalPositionPSym t) tt = HasTotalPositionP t tt