{-# LANGUAGE PolyKinds #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Generics.Internal.VL.Iso where
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity(..))
import Data.Profunctor
import GHC.Generics
import Data.Generics.Internal.GenericN (Rec (..), GenericN (..), Param (..))
import qualified Data.Generics.Internal.Profunctor.Iso as P
data Exchange a b s t = Exchange (s -> a) (b -> t)
instance Functor (Exchange a b s) where
fmap :: (a -> b) -> Exchange a b s a -> Exchange a b s b
fmap a -> b
f (Exchange s -> a
p b -> a
q) = (s -> a) -> (b -> b) -> Exchange a b s b
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange s -> a
p (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
q)
{-# INLINE fmap #-}
instance Profunctor (Exchange a b) where
dimap :: (a -> b) -> (c -> d) -> Exchange a b b c -> Exchange a b a d
dimap a -> b
f c -> d
g (Exchange b -> a
sa b -> c
bt) = (a -> a) -> (b -> d) -> Exchange a b a d
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
{-# INLINE dimap #-}
lmap :: (a -> b) -> Exchange a b b c -> Exchange a b a c
lmap a -> b
f (Exchange b -> a
sa b -> c
bt) = (a -> a) -> (b -> c) -> Exchange a b a c
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b -> c
bt
{-# INLINE lmap #-}
rmap :: (b -> c) -> Exchange a b a b -> Exchange a b a c
rmap b -> c
f (Exchange a -> a
sa b -> b
bt) = (a -> a) -> (b -> c) -> Exchange a b a c
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
sa (b -> c
f (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt)
{-# INLINE rmap #-}
type Iso' s a
= forall p f. (Profunctor p, Functor f) => p a (f a) -> p s (f s)
type Iso s t a b
= forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
fromIso :: Iso s t a b -> Iso b a t s
fromIso :: Iso s t a b -> Iso b a t s
fromIso Iso s t a b
l = Iso s t a b
-> ((s -> a) -> (b -> t) -> p t (f s) -> p b (f a))
-> p t (f s)
-> p b (f a)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
l (((s -> a) -> (b -> t) -> p t (f s) -> p b (f a))
-> p t (f s) -> p b (f a))
-> ((s -> a) -> (b -> t) -> p t (f s) -> p b (f a))
-> p t (f s)
-> p b (f a)
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (b -> t) -> (s -> a) -> Iso b a t s
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso b -> t
bt s -> a
sa
{-# inline fromIso #-}
iso2isovl :: P.Iso s t a b -> Iso s t a b
iso2isovl :: Iso s t a b -> Iso s t a b
iso2isovl Iso s t a b
_iso = Iso s t a b
-> ((s -> a) -> (b -> t) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
P.withIso Iso s t a b
_iso (((s -> a) -> (b -> t) -> p a (f b) -> p s (f t))
-> p a (f b) -> p s (f t))
-> ((s -> a) -> (b -> t) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (s -> a) -> (b -> t) -> Iso s t a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt
{-# INLINE iso2isovl #-}
withIso :: Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso :: Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
ai (s -> a) -> (b -> t) -> r
k = case Exchange a b a (Identity b) -> Exchange a b s (Identity t)
Iso s t a b
ai ((a -> a) -> (b -> Identity b) -> Exchange a b a (Identity b)
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
forall a. a -> a
id b -> Identity b
forall a. a -> Identity a
Identity) of
Exchange s -> a
sa b -> Identity t
bt -> (s -> a) -> (b -> t) -> r
k s -> a
sa ((b -> Identity t) -> b -> t
coerce b -> Identity t
bt)
{-# inline withIso #-}
repIso :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
repIso :: Iso a b (Rep a x) (Rep b x)
repIso = (a -> Rep a x) -> (Rep b x -> b) -> Iso a b (Rep a x) (Rep b x)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep b x -> b
forall a x. Generic a => Rep a x -> a
to
repIsoN :: (GenericN a, GenericN b) => Iso a b (RepN a x) (RepN b x)
repIsoN :: Iso a b (RepN a x) (RepN b x)
repIsoN = (a -> Rep (Indexed a 0) x)
-> (Rep (Indexed b 0) x -> b)
-> Iso a b (Rep (Indexed a 0) x) (Rep (Indexed b 0) x)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> Rep (Indexed a 0) x
forall a x. GenericN a => a -> RepN a x
fromN Rep (Indexed b 0) x -> b
forall a x. GenericN a => RepN a x -> a
toN
paramIso :: Iso (Param n a) (Param n b) a b
paramIso :: p a (f b) -> p (Param n a) (f (Param n b))
paramIso = (Param n a -> a)
-> (b -> Param n b) -> Iso (Param n a) (Param n b) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Param n a -> a
forall (n :: Nat) a. Param n a -> a
getStarParam b -> Param n b
forall (n :: Nat) a. a -> Param n a
StarParam
mIso :: Iso (M1 i c f p) (M1 i c g p) (f p) (g p)
mIso :: p (f p) (f (g p)) -> p (M1 i c f p) (f (M1 i c g p))
mIso = (M1 i c f p -> f p)
-> (g p -> M1 i c g p) -> Iso (M1 i c f p) (M1 i c g p) (f p) (g p)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso M1 i c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 g p -> M1 i c g p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1
kIso :: Iso (K1 r a p) (K1 r b p) a b
kIso :: p a (f b) -> p (K1 r a p) (f (K1 r b p))
kIso = (K1 r a p -> a) -> (b -> K1 r b p) -> Iso (K1 r a p) (K1 r b p) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso K1 r a p -> a
forall i c k (p :: k). K1 i c p -> c
unK1 b -> K1 r b p
forall k i c (p :: k). c -> K1 i c p
K1
recIso :: Iso (Rec r a p) (Rec r b p) a b
recIso :: p a (f b) -> p (Rec r a p) (f (Rec r b p))
recIso = (Rec r a p -> a)
-> (b -> Rec r b p) -> Iso (Rec r a p) (Rec r b p) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (K1 R a p -> a
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R a p -> a) -> (Rec r a p -> K1 R a p) -> Rec r a p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec r a p -> K1 R a p
forall p a k (x :: k). Rec p a x -> K1 R a x
unRec) (K1 R b p -> Rec r b p
forall k p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R b p -> Rec r b p) -> (b -> K1 R b p) -> b -> Rec r b p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> K1 R b p
forall k i c (p :: k). c -> K1 i c p
K1)
prodIso :: Iso ((a :*: b) x) ((a' :*: b') x) (a x, b x) (a' x, b' x)
prodIso :: p (a x, b x) (f (a' x, b' x))
-> p ((:*:) a b x) (f ((:*:) a' b' x))
prodIso = ((:*:) a b x -> (a x, b x))
-> ((a' x, b' x) -> (:*:) a' b' x)
-> Iso ((:*:) a b x) ((:*:) a' b' x) (a x, b x) (a' x, b' x)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(a x
a :*: b x
b) -> (a x
a, b x
b)) (\(a' x
a, b' x
b) -> (a' x
a a' x -> b' x -> (:*:) a' b' x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b' x
b))
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt = (s -> a) -> (f b -> f t) -> p a (f b) -> p s (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa ((b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)
{-# INLINE iso #-}