{-# LANGUAGE RankNTypes #-}
{-|
@'Iso'@s are the root of the optic hierarchy: an @'Iso'@ can be used anywhere any other kind of optic is required. On the other hand, if something requests an @'Iso'@, it can only be given an @'Iso'@, as it doesn't provide enough capabilities to accept anything else.

This implies that they're the weakest optic; they make the fewest assumptions, and thus can provide only the most minimal guarantees. Even so, these guarantees are relativevly strong: notionally, an @'Iso'@ consists of functions @/f/@ and @/g/@ which are mutual inverses:

@
f '.' g = 'id'
@
@
g '.' f = 'id'
@
-}
module Fresnel.Iso
( -- * Isos
  Iso
, Iso'
, IsIso
  -- * Construction
, iso
, from
  -- * Elimination
, withIso
, under
  -- * Functions
, constant
, constantWith
, involuted
, flipped
, curried
, uncurried
  -- * Relations
, non
, non'
  -- * Tuples
, swapped
, mirrored
  -- * Coercion
, coerced
, coercedTo
, coercedFrom
  -- * Functor
, fmapping
  -- * Contravariant
, contramapping
  -- * Bifunctor
, bimapping
, firsting
, seconding
  -- * Profunctor
, dimapping
, lmapping
, rmapping
  -- * (Co-)representable
, protabulated
, cotabulated
) where

import Control.Applicative (Alternative)
import Control.Monad (guard)
import Data.Bifunctor
import Data.Coerce (Coercible, coerce)
import Data.Functor.Contravariant
import Data.Maybe (fromMaybe)
import Data.Profunctor
import Data.Profunctor.Rep hiding (cotabulated)
import Data.Profunctor.Sieve
import Data.Tuple (swap)
import Fresnel.Iso.Internal
import Fresnel.Optic
import Fresnel.Optional (isn't)
import Fresnel.Prism (Prism', only)
import Fresnel.Profunctor.Coexp
import Fresnel.Review (review)

-- Isos

type Iso s t a b = forall p . IsIso p => Optic p s t a b

type Iso' s a = Iso s s a a


-- Construction

iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
f b -> t
g = s -> a
f (s -> a) -> (b -> t) -> p a b -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
`dimap` b -> t
g

from :: Iso s t a b -> Iso b a t s
from :: Iso s t a b -> Iso b a t s
from Iso s t a b
o = Iso s t a b
-> ((s -> a) -> (b -> t) -> p t s -> p b a) -> p t s -> p b a
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
o (((b -> t) -> (s -> a) -> p t s -> p b a)
-> (s -> a) -> (b -> t) -> p t s -> p b a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> t) -> (s -> a) -> p t s -> p b a
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap)


-- Elimination

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
i = Coexp b a s t -> forall r. ((b -> t) -> (s -> a) -> r) -> r
forall s t b a.
Coexp s t b a -> forall r. ((s -> a) -> (b -> t) -> r) -> r
withCoexp (Optic (Coexp b a) s t a b
Iso s t a b
i Coexp b a a b
forall a. Monoid a => a
mempty) (((b -> t) -> (s -> a) -> r) -> r)
-> (((s -> a) -> (b -> t) -> r) -> (b -> t) -> (s -> a) -> r)
-> ((s -> a) -> (b -> t) -> r)
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s -> a) -> (b -> t) -> r) -> (b -> t) -> (s -> a) -> r
forall a b c. (a -> b -> c) -> b -> a -> c
flip


under :: Iso s t a b -> (t -> s) -> (b -> a)
under :: Iso s t a b -> (t -> s) -> b -> a
under Iso s t a b
i = Iso s t a b
-> ((s -> a) -> (b -> t) -> (t -> s) -> b -> a)
-> (t -> s)
-> b
-> a
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
i (\ s -> a
f b -> t
r -> (s -> a
f (s -> a) -> (b -> s) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((b -> s) -> b -> a) -> ((t -> s) -> b -> s) -> (t -> s) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t -> s) -> (b -> t) -> b -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> t
r))


-- Functions

constant :: a -> Iso (a -> b) (a' -> b') b b'
constant :: a -> Iso (a -> b) (a' -> b') b b'
constant a
a = a
a a -> (b' -> a' -> b') -> Iso (a -> b) (a' -> b') b b'
forall a b' a' b.
a -> (b' -> a' -> b') -> Iso (a -> b) (a' -> b') b b'
`constantWith` b' -> a' -> b'
forall a b. a -> b -> a
const

constantWith :: a -> (b' -> a' -> b') -> Iso (a -> b) (a' -> b') b b'
constantWith :: a -> (b' -> a' -> b') -> Iso (a -> b) (a' -> b') b b'
constantWith a
a = ((a -> b) -> b) -> (b' -> a' -> b') -> Iso (a -> b) (a' -> b') b b'
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a)

involuted :: (a -> a) -> Iso' a a
involuted :: (a -> a) -> Iso' a a
involuted a -> a
f = (a -> a) -> (a -> a) -> Iso' a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> a
f a -> a
f

flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
flipped :: Optic
  p (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
flipped = ((a -> b -> c) -> b -> a -> c)
-> ((b' -> a' -> c') -> a' -> b' -> c')
-> Iso
     (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b' -> a' -> c') -> a' -> b' -> c'
forall a b c. (a -> b -> c) -> b -> a -> c
flip

curried :: Iso ((a, b) -> c) ((a', b') -> c') (a -> b -> c) (a' -> b' -> c')
curried :: Optic
  p ((a, b) -> c) ((a', b') -> c') (a -> b -> c) (a' -> b' -> c')
curried = (((a, b) -> c) -> a -> b -> c)
-> ((a' -> b' -> c') -> (a', b') -> c')
-> Iso
     ((a, b) -> c) ((a', b') -> c') (a -> b -> c) (a' -> b' -> c')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((a, b) -> c) -> a -> b -> c
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a' -> b' -> c') -> (a', b') -> c'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

uncurried :: Iso (a -> b -> c) (a' -> b' -> c') ((a, b) -> c) ((a', b') -> c')
uncurried :: Optic
  p (a -> b -> c) (a' -> b' -> c') ((a, b) -> c) ((a', b') -> c')
uncurried = ((a -> b -> c) -> (a, b) -> c)
-> (((a', b') -> c') -> a' -> b' -> c')
-> Iso
     (a -> b -> c) (a' -> b' -> c') ((a, b) -> c) ((a', b') -> c')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a', b') -> c') -> a' -> b' -> c'
forall a b c. ((a, b) -> c) -> a -> b -> c
curry


-- Relations

non :: Eq a => a -> Iso' (Maybe a) a
non :: a -> Iso' (Maybe a) a
non a
a = Prism' a () -> Iso' (Maybe a) a
forall a. Prism' a () -> Iso' (Maybe a) a
non' (a -> Prism' a ()
forall a. Eq a => a -> Prism' a ()
only a
a)

non' :: Prism' a () -> Iso' (Maybe a) a
non' :: Prism' a () -> Iso' (Maybe a) a
non' Prism' a ()
o = (Maybe a -> a) -> (a -> Maybe a) -> Iso' (Maybe a) a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Review a () -> () -> a
forall t b. Review t b -> b -> t
review Prism' a ()
Review a ()
o ())) ((a -> Bool) -> a -> Maybe a
forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
select (Optional a a () () -> a -> Bool
forall s t a b. Optional s t a b -> s -> Bool
isn't Prism' a ()
Optional a a () ()
o))


-- Tuples

swapped :: Iso (a, b) (a', b') (b, a) (b', a')
swapped :: Optic p (a, b) (a', b') (b, a) (b', a')
swapped = ((a, b) -> (b, a))
-> ((b', a') -> (a', b')) -> Iso (a, b) (a', b') (b, a) (b', a')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a, b) -> (b, a)
forall a b. (a, b) -> (b, a)
swap (b', a') -> (a', b')
forall a b. (a, b) -> (b, a)
swap

mirrored :: Iso (Either a b) (Either a' b') (Either b a) (Either b' a')
mirrored :: Optic p (Either a b) (Either a' b') (Either b a) (Either b' a')
mirrored = (Either a b -> Either b a)
-> (Either b' a' -> Either a' b')
-> Iso (Either a b) (Either a' b') (Either b a) (Either b' a')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Either a b -> Either b a
forall b a. Either b a -> Either a b
mirror Either b' a' -> Either a' b'
forall b a. Either b a -> Either a b
mirror
  where
  mirror :: Either b a -> Either a b
mirror = (b -> Either a b) -> (a -> Either a b) -> Either b a -> Either a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Either a b
forall a b. b -> Either a b
Right a -> Either a b
forall a b. a -> Either a b
Left


-- Coercion

coerced :: (Coercible s a, Coercible t b) => Iso s t a b
coerced :: Iso s t a b
coerced = s -> a
coerce (s -> a) -> (b -> t) -> Iso s t a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
`iso` b -> t
coerce

-- | Build a bidi coercion, taking a constructor for the type being built both to improve type inference and as documentation.
--
-- For example, given two newtypes @A@ and @B@ wrapping the same type, this expression:
--
-- @
-- 'coercedTo' B <<< 'coercedFrom' A
-- @
--
-- produces a bijection of type @'Iso'' A B@.
coercedTo :: Coercible t b => (s -> a) -> Iso s t a b
coercedTo :: (s -> a) -> Iso s t a b
coercedTo s -> a
f = s -> a
f (s -> a) -> (b -> t) -> Iso s t a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
`iso` b -> t
coerce

-- | Build a bidi coercion, taking a constructor for the type being eliminated both to improve type inference and as documentation.
--
-- For example, given two newtypes @A@ and @B@ wrapping the same type, this expression:
--
-- @
-- 'coercedTo' B <<< 'coercedFrom' A
-- @
--
-- produces a bijection of type @'Iso'' A B@.
coercedFrom :: Coercible s a => (b -> t) -> Iso s t a b
coercedFrom :: (b -> t) -> Iso s t a b
coercedFrom b -> t
g = s -> a
coerce (s -> a) -> (b -> t) -> Iso s t a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
`iso` b -> t
g


-- Functor

fmapping :: (Functor f, Functor g) => Iso s t a b -> Iso (f s) (g t) (f a) (g b)
fmapping :: Iso s t a b -> Iso (f s) (g t) (f a) (g b)
fmapping Iso s t a b
o = Iso s t a b
-> ((s -> a) -> (b -> t) -> Optic p (f s) (g t) (f a) (g b))
-> Optic p (f s) (g t) (f a) (g b)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
o (((s -> a) -> (b -> t) -> Optic p (f s) (g t) (f a) (g b))
 -> Optic p (f s) (g t) (f a) (g b))
-> ((s -> a) -> (b -> t) -> Optic p (f s) (g t) (f a) (g b))
-> Optic p (f s) (g t) (f a) (g b)
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (f s -> f a) -> (g b -> g t) -> Iso (f s) (g t) (f a) (g b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> f s -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> a
sa) ((b -> t) -> g b -> g t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)


-- Contravariant

contramapping :: (Contravariant f, Contravariant g) => Iso s t a b -> Iso (f a) (g b) (f s) (g t)
contramapping :: Iso s t a b -> Iso (f a) (g b) (f s) (g t)
contramapping Iso s t a b
o = Iso s t a b
-> ((s -> a) -> (b -> t) -> Optic p (f a) (g b) (f s) (g t))
-> Optic p (f a) (g b) (f s) (g t)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
o (((s -> a) -> (b -> t) -> Optic p (f a) (g b) (f s) (g t))
 -> Optic p (f a) (g b) (f s) (g t))
-> ((s -> a) -> (b -> t) -> Optic p (f a) (g b) (f s) (g t))
-> Optic p (f a) (g b) (f s) (g t)
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (f a -> f s) -> (g t -> g b) -> Iso (f a) (g b) (f s) (g t)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> f a -> f s
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap s -> a
sa) ((b -> t) -> g t -> g b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap b -> t
bt)


-- Bifunctor

bimapping :: (Bifunctor p, Bifunctor q) => Iso s t a b -> Iso s' t' a' b' -> Iso (p s s') (q t t') (p a a') (q b b')
bimapping :: Iso s t a b
-> Iso s' t' a' b' -> Iso (p s s') (q t t') (p a a') (q b b')
bimapping Iso s t a b
a Iso s' t' a' b'
b = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> Optic p (p s s') (q t t') (p a a') (q b b'))
-> Optic p (p s s') (q t t') (p a a') (q b b')
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
a (((s -> a)
  -> (b -> t) -> Optic p (p s s') (q t t') (p a a') (q b b'))
 -> Optic p (p s s') (q t t') (p a a') (q b b'))
-> ((s -> a)
    -> (b -> t) -> Optic p (p s s') (q t t') (p a a') (q b b'))
-> Optic p (p s s') (q t t') (p a a') (q b b')
forall a b. (a -> b) -> a -> b
$ \ s -> a
lsa b -> t
lbt -> Iso s' t' a' b'
-> ((s' -> a')
    -> (b' -> t') -> Optic p (p s s') (q t t') (p a a') (q b b'))
-> Optic p (p s s') (q t t') (p a a') (q b b')
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s' t' a' b'
b (((s' -> a')
  -> (b' -> t') -> Optic p (p s s') (q t t') (p a a') (q b b'))
 -> Optic p (p s s') (q t t') (p a a') (q b b'))
-> ((s' -> a')
    -> (b' -> t') -> Optic p (p s s') (q t t') (p a a') (q b b'))
-> Optic p (p s s') (q t t') (p a a') (q b b')
forall a b. (a -> b) -> a -> b
$ \ s' -> a'
rsa b' -> t'
rbt -> (p s s' -> p a a')
-> (q b b' -> q t t') -> Iso (p s s') (q t t') (p a a') (q b b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> (s' -> a') -> p s s' -> p a a'
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap s -> a
lsa s' -> a'
rsa) ((b -> t) -> (b' -> t') -> q b b' -> q t t'
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> t
lbt b' -> t'
rbt)

firsting :: (Bifunctor p, Bifunctor q) => Iso s t a b -> Iso (p s x) (q t y) (p a x) (q b y)
firsting :: Iso s t a b -> Iso (p s x) (q t y) (p a x) (q b y)
firsting Iso s t a b
a = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> Optic p (p s x) (q t y) (p a x) (q b y))
-> Optic p (p s x) (q t y) (p a x) (q b y)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
a (((s -> a) -> (b -> t) -> Optic p (p s x) (q t y) (p a x) (q b y))
 -> Optic p (p s x) (q t y) (p a x) (q b y))
-> ((s -> a)
    -> (b -> t) -> Optic p (p s x) (q t y) (p a x) (q b y))
-> Optic p (p s x) (q t y) (p a x) (q b y)
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (p s x -> p a x)
-> (q b y -> q t y) -> Iso (p s x) (q t y) (p a x) (q b y)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> p s x -> p a x
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> a
sa) ((b -> t) -> q b y -> q t y
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> t
bt)

seconding :: (Bifunctor p, Bifunctor q) => Iso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
seconding :: Iso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
seconding Iso s t a b
b = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> Optic p (p x s) (q y t) (p x a) (q y b))
-> Optic p (p x s) (q y t) (p x a) (q y b)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
b (((s -> a) -> (b -> t) -> Optic p (p x s) (q y t) (p x a) (q y b))
 -> Optic p (p x s) (q y t) (p x a) (q y b))
-> ((s -> a)
    -> (b -> t) -> Optic p (p x s) (q y t) (p x a) (q y b))
-> Optic p (p x s) (q y t) (p x a) (q y b)
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (p x s -> p x a)
-> (q y b -> q y t) -> Iso (p x s) (q y t) (p x a) (q y b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> p x s -> p x a
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second s -> a
sa) ((b -> t) -> q y b -> q y t
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> t
bt)


-- Profunctor

dimapping :: (Profunctor p, Profunctor q) => Iso s t a b -> Iso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b')
dimapping :: Iso s t a b
-> Iso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b')
dimapping Iso s t a b
a Iso s' t' a' b'
b = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> Optic p (p a s') (q b t') (p s a') (q t b'))
-> Optic p (p a s') (q b t') (p s a') (q t b')
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
a (((s -> a)
  -> (b -> t) -> Optic p (p a s') (q b t') (p s a') (q t b'))
 -> Optic p (p a s') (q b t') (p s a') (q t b'))
-> ((s -> a)
    -> (b -> t) -> Optic p (p a s') (q b t') (p s a') (q t b'))
-> Optic p (p a s') (q b t') (p s a') (q t b')
forall a b. (a -> b) -> a -> b
$ \ s -> a
lsa b -> t
lbt -> Iso s' t' a' b'
-> ((s' -> a')
    -> (b' -> t') -> Optic p (p a s') (q b t') (p s a') (q t b'))
-> Optic p (p a s') (q b t') (p s a') (q t b')
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s' t' a' b'
b (((s' -> a')
  -> (b' -> t') -> Optic p (p a s') (q b t') (p s a') (q t b'))
 -> Optic p (p a s') (q b t') (p s a') (q t b'))
-> ((s' -> a')
    -> (b' -> t') -> Optic p (p a s') (q b t') (p s a') (q t b'))
-> Optic p (p a s') (q b t') (p s a') (q t b')
forall a b. (a -> b) -> a -> b
$ \ s' -> a'
rsa b' -> t'
rbt -> (p a s' -> p s a')
-> (q t b' -> q b t') -> Iso (p a s') (q b t') (p s a') (q t b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> (s' -> a') -> p a s' -> p s a'
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
lsa s' -> a'
rsa) ((b -> t) -> (b' -> t') -> q t b' -> q b t'
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap b -> t
lbt b' -> t'
rbt)

lmapping :: (Profunctor p, Profunctor q) => Iso s t a b -> Iso (p a x) (q b y) (p s x) (q t y)
lmapping :: Iso s t a b -> Iso (p a x) (q b y) (p s x) (q t y)
lmapping Iso s t a b
a = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> Optic p (p a x) (q b y) (p s x) (q t y))
-> Optic p (p a x) (q b y) (p s x) (q t y)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
a (((s -> a) -> (b -> t) -> Optic p (p a x) (q b y) (p s x) (q t y))
 -> Optic p (p a x) (q b y) (p s x) (q t y))
-> ((s -> a)
    -> (b -> t) -> Optic p (p a x) (q b y) (p s x) (q t y))
-> Optic p (p a x) (q b y) (p s x) (q t y)
forall a b. (a -> b) -> a -> b
$ \ s -> a
lsa b -> t
lbt -> (p a x -> p s x)
-> (q t y -> q b y) -> Iso (p a x) (q b y) (p s x) (q t y)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> p a x -> p s x
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap s -> a
lsa) ((b -> t) -> q t y -> q b y
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap b -> t
lbt)

rmapping :: (Profunctor p, Profunctor q) => Iso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
rmapping :: Iso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
rmapping Iso s t a b
b = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> Optic p (p x s) (q y t) (p x a) (q y b))
-> Optic p (p x s) (q y t) (p x a) (q y b)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
b (((s -> a) -> (b -> t) -> Optic p (p x s) (q y t) (p x a) (q y b))
 -> Optic p (p x s) (q y t) (p x a) (q y b))
-> ((s -> a)
    -> (b -> t) -> Optic p (p x s) (q y t) (p x a) (q y b))
-> Optic p (p x s) (q y t) (p x a) (q y b)
forall a b. (a -> b) -> a -> b
$ \ s -> a
rsa b -> t
rbt -> (p x s -> p x a)
-> (q y b -> q y t) -> Iso (p x s) (q y t) (p x a) (q y b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> p x s -> p x a
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap s -> a
rsa) ((b -> t) -> q y b -> q y t
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> t
rbt)


-- (Co-)representable (profunctorial)

protabulated :: (Representable p, Representable q) => Iso (a -> Rep p b) (a' -> Rep q b') (p a b) (q a' b')
protabulated :: Iso (a -> Rep p b) (a' -> Rep q b') (p a b) (q a' b')
protabulated = (a -> Rep p b) -> p a b
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((a -> Rep p b) -> p a b)
-> (q a' b' -> a' -> Rep q b')
-> Iso (a -> Rep p b) (a' -> Rep q b') (p a b) (q a' b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
`iso` q a' b' -> a' -> Rep q b'
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve

cotabulated :: (Corepresentable p, Corepresentable q) => Iso (Corep p a -> b) (Corep q a' -> b') (p a b) (q a' b')
cotabulated :: Iso (Corep p a -> b) (Corep q a' -> b') (p a b) (q a' b')
cotabulated = (Corep p a -> b) -> p a b
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> b) -> p a b)
-> (q a' b' -> Corep q a' -> b')
-> Iso (Corep p a -> b) (Corep q a' -> b') (p a b) (q a' b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
`iso` q a' b' -> Corep q a' -> b'
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve


-- Utilities

select :: Alternative f => (a -> Bool) -> (a -> f a)
select :: (a -> Bool) -> a -> f a
select a -> Bool
p a
a = a
a a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
a)