{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE PolyKinds #-}
#else
{-# LANGUAGE TypeInType #-}
#endif
#include "lens-common.h"
module Control.Lens.Iso
(
Iso, Iso'
, AnIso, AnIso'
, iso
, from
, cloneIso
, withIso
, au
, auf
, xplat
, xplatf
, under
, mapping
, simple
, non, non'
, anon
, enum
, curried, uncurried
, flipped
, swapped
, pattern Swapped
, strict, lazy
, pattern Strict
, pattern Lazy
, Reversing(..)
, reversed
, pattern Reversed
, involuted
, pattern List
, magma
, imagma
, Magma
, contramapping
, Profunctor(dimap,rmap,lmap)
, dimapping
, lmapping
, rmapping
, bimapping
, firsting
, seconding
, coerced
) where
import Control.Lens.Equality (simple)
import Control.Lens.Getter
import Control.Lens.Fold
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Control.Lens.Internal.Iso as Iso
import Control.Lens.Internal.Magma
import Control.Lens.Prism
import Control.Lens.Review
import Control.Lens.Type
import Data.Bifunctor
import Data.Bifunctor.Swap (Swap (..))
import Data.Functor.Identity
import Data.Strict.Classes (Strict (..))
import Data.Maybe
import Data.Profunctor
import Data.Profunctor.Unsafe
import Data.Coerce
import qualified GHC.Exts as Exts
import GHC.Exts (TYPE)
type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t)
type AnIso' s a = AnIso s s a a
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)
{-# INLINE iso #-}
from :: AnIso s t a b -> Iso b a t s
from :: forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso s t a b
l = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
l forall a b. (a -> b) -> a -> b
$ \s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso b -> t
bt s -> a
sa
{-# INLINE from #-}
withIso :: forall s t a b rep (r :: TYPE rep).
AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso :: forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
ai (s -> a) -> (b -> t) -> r
k = case AnIso s t a b
ai (forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange forall a. a -> a
id forall a. a -> Identity a
Identity) of
Exchange s -> a
sa b -> Identity t
bt -> (s -> a) -> (b -> t) -> r
k s -> a
sa (forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> Identity t
bt)
{-# INLINE withIso #-}
cloneIso :: AnIso s t a b -> Iso s t a b
cloneIso :: forall s t a b. AnIso s t a b -> Iso s t a b
cloneIso AnIso s t a b
k = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
k forall a b. (a -> b) -> a -> b
$ \s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt
{-# INLINE cloneIso #-}
au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a
au :: forall (f :: * -> *) s t a b.
Functor f =>
AnIso s t a b -> ((b -> t) -> f s) -> f a
au AnIso s t a b
k = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
k forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt (b -> t) -> f s
f -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> a
sa ((b -> t) -> f s
f b -> t
bt)
{-# INLINE au #-}
auf :: (Functor f, Functor g) => AnIso s t a b -> (f t -> g s) -> f b -> g a
auf :: forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> (f t -> g s) -> f b -> g a
auf AnIso s t a b
k f t -> g s
ftgs f b
fb = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
k forall a b. (a -> b) -> a -> b
$ \s -> a
sa b -> t
bt -> s -> a
sa forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f t -> g s
ftgs (b -> t
bt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
fb)
{-# INLINE auf #-}
xplat :: Optic (Costar ((->) s)) g s t a b -> ((s -> a) -> g b) -> g t
xplat :: forall {k} s (g :: k -> *) (t :: k) a (b :: k).
Optic (Costar ((->) s)) g s t a b -> ((s -> a) -> g b) -> g t
xplat Optic (Costar ((->) s)) g s t a b
f (s -> a) -> g b
g = forall {k} {k} (f :: k -> *) (g :: k -> *) (s :: k) (t :: k)
(a :: k) (b :: k).
Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t
xplatf Optic (Costar ((->) s)) g s t a b
f (s -> a) -> g b
g forall a. a -> a
id
xplatf :: Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t
xplatf :: forall {k} {k} (f :: k -> *) (g :: k -> *) (s :: k) (t :: k)
(a :: k) (b :: k).
Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t
xplatf = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE xplat #-}
under :: AnIso s t a b -> (t -> s) -> b -> a
under :: forall s t a b. AnIso s t a b -> (t -> s) -> b -> a
under AnIso s t a b
k = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
k forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt t -> s
ts -> s -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> s
ts forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> t
bt
{-# INLINE under #-}
enum :: Enum a => Iso' Int a
enum :: forall a. Enum a => Iso' Int a
enum = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a. Enum a => Int -> a
toEnum forall a. Enum a => a -> Int
fromEnum
{-# INLINE enum #-}
mapping :: (Functor f, Functor g) => AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping :: forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso s t a b
k = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
k forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> a
sa) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)
{-# INLINE mapping #-}
non :: Eq a => a -> Iso' (Maybe a) a
non :: forall a. Eq a => a -> Iso' (Maybe a) a
non a
a = forall a. APrism' a () -> Iso' (Maybe a) a
non' forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> Prism' a ()
only a
a
{-# INLINE non #-}
non' :: APrism' a () -> Iso' (Maybe a) a
non' :: forall a. APrism' a () -> Iso' (Maybe a) a
non' APrism' a ()
p = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. a -> Maybe a -> a
fromMaybe a
def) a -> Maybe a
go where
def :: a
def = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review (forall s t a b. APrism s t a b -> Prism s t a b
clonePrism APrism' a ()
p) ()
go :: a -> Maybe a
go a
b | forall s a. Getting Any s a -> s -> Bool
has (forall s t a b. APrism s t a b -> Prism s t a b
clonePrism APrism' a ()
p) a
b = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just a
b
{-# INLINE non' #-}
anon :: a -> (a -> Bool) -> Iso' (Maybe a) a
anon :: forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon a
a a -> Bool
p = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. a -> Maybe a -> a
fromMaybe a
a) a -> Maybe a
go where
go :: a -> Maybe a
go a
b | a -> Bool
p a
b = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just a
b
{-# INLINE anon #-}
curried :: Iso ((a,b) -> c) ((d,e) -> f) (a -> b -> c) (d -> e -> f)
curried :: forall a b c d e f.
Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
curried = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry
{-# INLINE curried #-}
uncurried :: Iso (a -> b -> c) (d -> e -> f) ((a,b) -> c) ((d,e) -> f)
uncurried :: forall a b c d e f.
Iso (a -> b -> c) (d -> e -> f) ((a, b) -> c) ((d, e) -> f)
uncurried = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b c. ((a, b) -> c) -> a -> b -> c
curry
{-# INLINE uncurried #-}
flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
flipped :: forall a b c a' b' c'.
Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
flipped = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE flipped #-}
swapped :: Swap p => Iso (p a b) (p c d) (p b a) (p d c)
swapped :: forall (p :: * -> * -> *) a b c d.
Swap p =>
Iso (p a b) (p c d) (p b a) (p d c)
swapped = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap
{-# INLINE swapped #-}
strict :: Strict lazy strict => Iso' lazy strict
strict :: forall lazy strict. Strict lazy strict => Iso' lazy strict
strict = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall lazy strict. Strict lazy strict => lazy -> strict
toStrict forall lazy strict. Strict lazy strict => strict -> lazy
toLazy
{-# INLINE strict #-}
pattern Strict :: Strict s t => t -> s
pattern $bStrict :: forall lazy strict. Strict lazy strict => strict -> lazy
$mStrict :: forall {r} {s} {t}.
Strict s t =>
s -> (t -> r) -> ((# #) -> r) -> r
Strict a <- (view strict -> a) where
Strict t
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall lazy strict. Strict lazy strict => Iso' lazy strict
strict t
a
pattern Lazy :: Strict t s => t -> s
pattern $bLazy :: forall lazy strict. Strict lazy strict => lazy -> strict
$mLazy :: forall {r} {t} {s}.
Strict t s =>
s -> (t -> r) -> ((# #) -> r) -> r
Lazy a <- (view lazy -> a) where
Lazy t
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy t
a
pattern Swapped :: Swap p => p b a -> p a b
pattern $bSwapped :: forall (p :: * -> * -> *) b a. Swap p => p b a -> p a b
$mSwapped :: forall {r} {p :: * -> * -> *} {b} {a}.
Swap p =>
p a b -> (p b a -> r) -> ((# #) -> r) -> r
Swapped a <- (view swapped -> a) where
Swapped p b a
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall (p :: * -> * -> *) a b c d.
Swap p =>
Iso (p a b) (p c d) (p b a) (p d c)
swapped p b a
a
pattern Reversed :: Reversing t => t -> t
pattern $bReversed :: forall t. Reversing t => t -> t
$mReversed :: forall {r} {t}. Reversing t => t -> (t -> r) -> ((# #) -> r) -> r
Reversed a <- (view reversed -> a) where
Reversed t
a = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall a. Reversing a => Iso' a a
reversed t
a
lazy :: Strict lazy strict => Iso' strict lazy
lazy :: forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall lazy strict. Strict lazy strict => strict -> lazy
toLazy forall lazy strict. Strict lazy strict => lazy -> strict
toStrict
{-# INLINE lazy #-}
reversed :: Reversing a => Iso' a a
reversed :: forall a. Reversing a => Iso' a a
reversed = forall a. (a -> a) -> Iso' a a
involuted forall t. Reversing t => t -> t
Iso.reversing
involuted :: (a -> a) -> Iso' a a
involuted :: forall a. (a -> a) -> Iso' a a
involuted a -> a
a = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> a
a a -> a
a
{-# INLINE involuted #-}
pattern List :: Exts.IsList l => [Exts.Item l] -> l
pattern $bList :: forall l. IsList l => [Item l] -> l
$mList :: forall {r} {l}.
IsList l =>
l -> ([Item l] -> r) -> ((# #) -> r) -> r
List a <- (Exts.toList -> a) where
List [Item l]
a = forall l. IsList l => [Item l] -> l
Exts.fromList [Item l]
a
magma :: LensLike (Mafic a b) s t a b -> Iso s u (Magma Int t b a) (Magma j u c c)
magma :: forall a b s t u j c.
LensLike (Mafic a b) s t a b
-> Iso s u (Magma Int t b a) (Magma j u c c)
magma LensLike (Mafic a b) s t a b
l = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a b t. Mafic a b t -> Magma Int t b a
runMafic forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
`rmap` LensLike (Mafic a b) s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell) forall i t a. Magma i t a a -> t
runMagma
{-# INLINE magma #-}
imagma :: Over (Indexed i) (Molten i a b) s t a b -> Iso s t' (Magma i t b a) (Magma j t' c c)
imagma :: forall i a b s t t' j c.
Over (Indexed i) (Molten i a b) s t a b
-> Iso s t' (Magma i t b a) (Magma j t' c c)
imagma Over (Indexed i) (Molten i a b) s t a b
l = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall i a b t. Molten i a b t -> Magma i t b a
runMolten forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Over (Indexed i) (Molten i a b) s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell) (forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall i a b t. Magma i t b a -> Molten i a b t
Molten)
{-# INLINE imagma #-}
contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t)
contramapping :: forall (f :: * -> *) s t a b.
Contravariant f =>
AnIso s t a b -> Iso (f a) (f b) (f s) (f t)
contramapping AnIso s t a b
f = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
f forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap s -> a
sa) (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap b -> t
bt)
{-# INLINE contramapping #-}
dimapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b')
dimapping :: forall (p :: * -> * -> *) (q :: * -> * -> *) s t a b s' t' a' b'.
(Profunctor p, Profunctor q) =>
AnIso s t a b
-> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b')
dimapping AnIso s t a b
f AnIso s' t' a' b'
g = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
f forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s' t' a' b'
g forall a b. (a -> b) -> a -> b
$ \ s' -> a'
s'a' b' -> t'
b't' ->
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa s' -> a'
s'a') (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap b -> t
bt b' -> t'
b't')
{-# INLINE dimapping #-}
lmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y)
lmapping :: forall (p :: * -> * -> *) (q :: * -> * -> *) s t a b x y.
(Profunctor p, Profunctor q) =>
AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y)
lmapping AnIso s t a b
f = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
f forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap s -> a
sa) (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap b -> t
bt)
{-# INLINE lmapping #-}
rmapping :: (Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
rmapping :: forall (p :: * -> * -> *) (q :: * -> * -> *) s t a b x y.
(Profunctor p, Profunctor q) =>
AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
rmapping AnIso s t a b
g = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
g forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap s -> a
sa) (forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> t
bt)
{-# INLINE rmapping #-}
bimapping :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
bimapping :: forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b s' t' a' b'.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b
-> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
bimapping AnIso s t a b
f AnIso s' t' a' b'
g = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
f forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s' t' a' b'
g forall a b. (a -> b) -> a -> b
$ \s' -> a'
s'a' b' -> t'
b't' ->
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap s -> a
sa s' -> a'
s'a') (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> t
bt b' -> t'
b't')
{-# INLINE bimapping #-}
firsting :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y)
firsting :: forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b x y.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y)
firsting AnIso s t a b
p = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
p forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> a
sa) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> t
bt)
{-# INLINE firsting #-}
seconding :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b)
seconding :: forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b x y.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b)
seconding AnIso s t a b
p = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
p forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second s -> a
sa) (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> t
bt)
{-# INLINE seconding #-}
coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced p a (f b)
l = forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap coerce :: forall a b. Coercible a b => a -> b
coerce) p a (f b)
l forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE coerced #-}