{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Data.Ten.Lens
( rep10, field10, ixRep10, ap10, comp
, _Field10, _Field10', (!=), (!=?), fragmented
) where
import Data.Functor.Contravariant (contramap)
import Data.Type.Equality ((:~:)(..))
import Control.Lens (Getting, Prism', Iso, iso, view)
import Control.Lens.Setter ((%~), Setter, ASetter, setting)
import Data.GADT.Compare (GEq(..))
import Data.Profunctor (dimap, right')
import Data.Ten.Ap (Ap10(..))
import Data.Ten.Sigma ((:**)(..), OpCostar, lmapFragment)
import Data.Ten.Representable (Representable10(..), rep10', field10')
import Data.Ten.Update (ixRep10)
import Data.Ten ((:.:)(..))
rep10
:: Representable10 f
=> Getting (Rep10 f a) (f (Rep10 f)) (Rep10 f a) -> Rep10 f a
rep10 :: Getting (Rep10 f a) (f (Rep10 f)) (Rep10 f a) -> Rep10 f a
rep10 Getting (Rep10 f a) (f (Rep10 f)) (Rep10 f a)
l = (f (Rep10 f) -> Rep10 f a) -> Rep10 f a
forall k (f :: (k -> *) -> *) (a :: k).
Representable10 f =>
(f (Rep10 f) -> Rep10 f a) -> Rep10 f a
rep10' (Getting (Rep10 f a) (f (Rep10 f)) (Rep10 f a)
-> f (Rep10 f) -> Rep10 f a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Rep10 f a) (f (Rep10 f)) (Rep10 f a)
l)
field10
:: Representable10 rec
=> Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> Rep10 rec a
field10 :: Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> Rep10 rec a
field10 Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
l = (rec (Rep10 rec) -> Ap10 a (Rep10 rec)) -> Rep10 rec a
forall k (rec :: (k -> *) -> *) (a :: k).
Representable10 rec =>
(rec (Rep10 rec) -> Ap10 a (Rep10 rec)) -> Rep10 rec a
field10' (Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> rec (Rep10 rec) -> Ap10 a (Rep10 rec)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
l)
ap10 :: Iso (Ap10 s fs) (Ap10 t ft) (fs s) (ft t)
ap10 :: p (fs s) (f (ft t)) -> p (Ap10 s fs) (f (Ap10 t ft))
ap10 = (Ap10 s fs -> fs s)
-> (ft t -> Ap10 t ft) -> Iso (Ap10 s fs) (Ap10 t ft) (fs s) (ft t)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Ap10 s fs -> fs s
forall k (a :: k) (f :: k -> *). Ap10 a f -> f a
unAp10 ft t -> Ap10 t ft
forall k (a :: k) (f :: k -> *). f a -> Ap10 a f
Ap10
comp :: Iso ((m :.: n) a) ((k :.: l) b) (m (n a)) (k (l b))
comp :: p (m (n a)) (f (k (l b))) -> p ((:.:) m n a) (f ((:.:) k l b))
comp = ((:.:) m n a -> m (n a))
-> (k (l b) -> (:.:) k l b)
-> Iso ((:.:) m n a) ((:.:) k l b) (m (n a)) (k (l b))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (:.:) m n a -> m (n a)
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 k (l b) -> (:.:) k l b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1
_Field10
:: GEq k
=> k a -> Prism' (k :** m) (m a)
_Field10 :: k a -> Prism' (k :** m) (m a)
_Field10 k a
k = ((k :** m) -> Either (k :** m) (m a))
-> (Either (k :** m) (f (m a)) -> f (k :** m))
-> p (Either (k :** m) (m a)) (Either (k :** m) (f (m a)))
-> p (k :** m) (f (k :** m))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (k :** m) -> Either (k :** m) (m a)
toE Either (k :** m) (f (m a)) -> f (k :** m)
fromE (p (Either (k :** m) (m a)) (Either (k :** m) (f (m a)))
-> p (k :** m) (f (k :** m)))
-> (p (m a) (f (m a))
-> p (Either (k :** m) (m a)) (Either (k :** m) (f (m a))))
-> p (m a) (f (m a))
-> p (k :** m) (f (k :** m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (m a) (f (m a))
-> p (Either (k :** m) (m a)) (Either (k :** m) (f (m a)))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
where
toE :: (k :** m) -> Either (k :** m) (m a)
toE frag :: k :** m
frag@(k a
k' :** m a
m) = case k a -> k a -> Maybe (a :~: a)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq k a
k k a
k' of
Just a :~: a
Refl -> m a -> Either (k :** m) (m a)
forall a b. b -> Either a b
Right m a
m
Maybe (a :~: a)
Nothing -> (k :** m) -> Either (k :** m) (m a)
forall a b. a -> Either a b
Left k :** m
frag
fromE :: Either (k :** m) (f (m a)) -> f (k :** m)
fromE = ((k :** m) -> f (k :** m))
-> (f (m a) -> f (k :** m))
-> Either (k :** m) (f (m a))
-> f (k :** m)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (k :** m) -> f (k :** m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((m a -> k :** m) -> f (m a) -> f (k :** m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k a
k k a -> m a -> k :** m
forall (k :: * -> *) (m :: * -> *) a. k a -> m a -> k :** m
:**))
_Field10'
:: forall rec a m
. (GEq (Rep10 rec), Representable10 rec)
=> (forall n. Getting (Ap10 a n) (rec n) (Ap10 a n))
-> Prism' (Rep10 rec :** m) (m a)
_Field10' :: (forall (n :: * -> *). Getting (Ap10 a n) (rec n) (Ap10 a n))
-> Prism' (Rep10 rec :** m) (m a)
_Field10' forall (n :: * -> *). Getting (Ap10 a n) (rec n) (Ap10 a n)
l = Rep10 rec a -> Prism' (Rep10 rec :** m) (m a)
forall (k :: * -> *) a (m :: * -> *).
GEq k =>
k a -> Prism' (k :** m) (m a)
_Field10 @(Rep10 rec) (Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> Rep10 rec a
forall (rec :: (* -> *) -> *) a.
Representable10 rec =>
Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> Rep10 rec a
field10 Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
forall (n :: * -> *). Getting (Ap10 a n) (rec n) (Ap10 a n)
l)
infixr 5 !=
(!=)
:: Representable10 rec
=> (forall m. Getting (Ap10 a m) (rec m) (Ap10 a m))
-> f a -> Rep10 rec :** f
forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m)
l != :: (forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m))
-> f a -> Rep10 rec :** f
!= f a
x = Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> Rep10 rec a
forall (rec :: (* -> *) -> *) a.
Representable10 rec =>
Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
-> Rep10 rec a
field10 Getting (Ap10 a (Rep10 rec)) (rec (Rep10 rec)) (Ap10 a (Rep10 rec))
forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m)
l Rep10 rec a -> f a -> Rep10 rec :** f
forall (k :: * -> *) (m :: * -> *) a. k a -> m a -> k :** m
:** f a
x
infixr 5 !=?
(!=?)
:: (Representable10 rec, Applicative f)
=> (forall m. Getting (Ap10 a m) (rec m) (Ap10 a m))
-> a -> Rep10 rec :** f
forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m)
l !=? :: (forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m))
-> a -> Rep10 rec :** f
!=? a
x = forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m)
l (forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m))
-> f a -> Rep10 rec :** f
forall (rec :: (* -> *) -> *) a (f :: * -> *).
Representable10 rec =>
(forall (m :: * -> *). Getting (Ap10 a m) (rec m) (Ap10 a m))
-> f a -> Rep10 rec :** f
!= a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
fragmented
:: ( Functor m, Representable10 recA, Representable10 recB
, f ~ OpCostar m (Rep10 recB :** m)
)
=> ASetter (recB f) (recA f) (f b) (f a)
-> Setter (Rep10 recA :** m) (Rep10 recB :** m) a b
fragmented :: ASetter (recB f) (recA f) (f b) (f a)
-> Setter (Rep10 recA :** m) (Rep10 recB :** m) a b
fragmented ASetter (recB f) (recA f) (f b) (f a)
l = ((a -> b) -> (Rep10 recA :** m) -> Rep10 recB :** m)
-> IndexPreservingSetter (Rep10 recA :** m) (Rep10 recB :** m) a b
forall a b s t.
((a -> b) -> s -> t) -> IndexPreservingSetter s t a b
setting (((a -> b) -> (Rep10 recA :** m) -> Rep10 recB :** m)
-> IndexPreservingSetter (Rep10 recA :** m) (Rep10 recB :** m) a b)
-> ((a -> b) -> (Rep10 recA :** m) -> Rep10 recB :** m)
-> IndexPreservingSetter (Rep10 recA :** m) (Rep10 recB :** m) a b
forall a b. (a -> b) -> a -> b
$ \a -> b
f -> (recB f -> recA f) -> (Rep10 recA :** m) -> Rep10 recB :** m
forall (recA :: (* -> *) -> *) (recB :: (* -> *) -> *)
(m :: * -> *) (f :: * -> *).
(Representable10 recA, Representable10 recB,
f ~ OpCostar m (Rep10 recB :** m)) =>
(recB f -> recA f) -> (Rep10 recA :** m) -> Rep10 recB :** m
lmapFragment (ASetter (recB f) (recA f) (f b) (f a)
l ASetter (recB f) (recA f) (f b) (f a)
-> (f b -> f a) -> recB f -> recA f
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f)