{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

module Control.Optics.Linear.Internal
  ( -- * Types
    Optic_(..)
  , Optic
  , Iso, Iso'
  , Lens, Lens'
  , Prism, Prism'
  , Traversal, Traversal'
    -- * Composing optics
  , (.>)
    -- * Common optics
  , swap, assoc
  , _1, _2
  , _Left, _Right
  , _Just, _Nothing
  , traversed
    -- * Using optics
  , get, set, gets, setSwap
  , match, build
  , over, overU
  , traverseOf, traverseOfU
  , toListOf, lengthOf
  , reifyLens
  , withIso, withLens, withPrism
    -- * Constructing optics
  , iso, lens, prism, traversal
  )
  where

import qualified Control.Arrow as NonLinear
import qualified Control.Functor.Linear as Control
import qualified Data.Bifunctor.Linear as Bifunctor
import Data.Bifunctor.Linear (SymmetricMonoidal)
import Data.Profunctor.Linear
import Data.Functor.Compose hiding (getCompose)
import Data.Functor.Linear
import qualified Data.Profunctor.Kleisli.Linear as Linear
import Data.Void
import GHC.Exts (FUN)
import GHC.Types
import Prelude.Linear
import qualified Prelude

newtype Optic_ arr s t a b = Optical (a `arr` b -> s `arr` t)

type Optic c s t a b =
  forall arr. c arr => Optic_ arr s t a b

type Iso s t a b = Optic Profunctor s t a b
type Iso' s a = Iso s s a a
type Lens s t a b = Optic (Strong (,) ()) s t a b
type Lens' s a = Lens s s a a
type Prism s t a b = Optic (Strong Either Void) s t a b
type Prism' s a = Prism s s a a
type Traversal s t a b = Optic Wandering s t a b
type Traversal' s a = Traversal s s a a

swap :: SymmetricMonoidal m u => Iso (a `m` b) (c `m` d) (b `m` a) (d `m` c)
swap :: forall (m :: * -> * -> *) u a b c d.
SymmetricMonoidal m u =>
Iso (m a b) (m c d) (m b a) (m d c)
swap = (m a b %1 -> m b a)
-> (m d c %1 -> m c d) -> Iso (m a b) (m c d) (m b a) (m d c)
forall s a b t. (s %1 -> a) -> (b %1 -> t) -> Iso s t a b
iso m a b %1 -> m b a
forall (m :: * -> * -> *) u a b.
SymmetricMonoidal m u =>
m a b %1 -> m b a
Bifunctor.swap m d c %1 -> m c d
forall (m :: * -> * -> *) u a b.
SymmetricMonoidal m u =>
m a b %1 -> m b a
Bifunctor.swap

assoc :: SymmetricMonoidal m u => Iso (a `m` (b `m` c)) (d `m` (e `m` f)) ((a `m` b) `m` c) ((d `m` e) `m` f)
assoc :: forall (m :: * -> * -> *) u a b c d e f.
SymmetricMonoidal m u =>
Iso (m a (m b c)) (m d (m e f)) (m (m a b) c) (m (m d e) f)
assoc = (m a (m b c) %1 -> m (m a b) c)
-> (m (m d e) f %1 -> m d (m e f))
-> Iso (m a (m b c)) (m d (m e f)) (m (m a b) c) (m (m d e) f)
forall s a b t. (s %1 -> a) -> (b %1 -> t) -> Iso s t a b
iso m a (m b c) %1 -> m (m a b) c
forall (m :: * -> * -> *) u a b c.
SymmetricMonoidal m u =>
m a (m b c) %1 -> m (m a b) c
Bifunctor.lassoc m (m d e) f %1 -> m d (m e f)
forall (m :: * -> * -> *) u a b c.
SymmetricMonoidal m u =>
m (m a b) c %1 -> m a (m b c)
Bifunctor.rassoc

(.>) :: Optic_ arr s t a b -> Optic_ arr a b x y -> Optic_ arr s t x y
Optical arr a b -> arr s t
f .> :: forall (arr :: * -> * -> *) s t a b x y.
Optic_ arr s t a b -> Optic_ arr a b x y -> Optic_ arr s t x y
.> Optical arr x y -> arr a b
g = (arr x y -> arr s t) -> Optic_ arr s t x y
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical (arr a b -> arr s t
f (arr a b -> arr s t) -> (arr x y -> arr a b) -> arr x y -> arr s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. arr x y -> arr a b
g)


lens :: (s %1-> (a, b %1-> t)) -> Lens s t a b
lens :: forall s a b t. (s %1 -> (a, b %1 -> t)) -> Lens s t a b
lens s %1 -> (a, b %1 -> t)
k = (arr a b -> arr s t) %1 -> Optic_ arr s t a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical ((arr a b -> arr s t) %1 -> Optic_ arr s t a b)
%1 -> (arr a b -> arr s t) %1 -> Optic_ arr s t a b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ \arr a b
f -> (s %1 -> (a, b %1 -> t))
-> ((b, b %1 -> t) %1 -> t)
-> arr (a, b %1 -> t) (b, b %1 -> t)
-> arr s t
forall (arr :: * -> * -> *) s a b t.
Profunctor arr =>
(s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
dimap s %1 -> (a, b %1 -> t)
k (\(b
x,b %1 -> t
g) -> b %1 -> t
g (b %1 -> t) %1 -> b %1 -> t
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b
x) (arr a b -> arr (a, b %1 -> t) (b, b %1 -> t)
forall (m :: * -> * -> *) u (arr :: * -> * -> *) a b c.
Strong m u arr =>
arr a b -> arr (m a c) (m b c)
first arr a b
f)

prism :: (b %1-> t) -> (s %1-> Either t a) -> Prism s t a b
prism :: forall b t s a.
(b %1 -> t) -> (s %1 -> Either t a) -> Prism s t a b
prism b %1 -> t
b s %1 -> Either t a
s = (arr a b -> arr s t) %1 -> Optic_ arr s t a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical ((arr a b -> arr s t) %1 -> Optic_ arr s t a b)
%1 -> (arr a b -> arr s t) %1 -> Optic_ arr s t a b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ \arr a b
f -> (s %1 -> Either t a)
-> (Either t t %1 -> t) -> arr (Either t a) (Either t t) -> arr s t
forall (arr :: * -> * -> *) s a b t.
Profunctor arr =>
(s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
dimap s %1 -> Either t a
s ((t %1 -> t) -> (t %1 -> t) -> Either t t %1 -> t
forall a c b. (a %1 -> c) -> (b %1 -> c) -> Either a b %1 -> c
either t %1 -> t
forall a. a %1 -> a
id t %1 -> t
forall a. a %1 -> a
id) (arr a t -> arr (Either t a) (Either t t)
forall (m :: * -> * -> *) u (arr :: * -> * -> *) b c a.
Strong m u arr =>
arr b c -> arr (m a b) (m a c)
second ((b %1 -> t) -> arr a b -> arr a t
forall (arr :: * -> * -> *) b t s.
Profunctor arr =>
(b %1 -> t) -> arr s b -> arr s t
rmap b %1 -> t
b arr a b
f))

traversal :: (forall f. Control.Applicative f => (a %1-> f b) -> s %1-> f t) -> Traversal s t a b
traversal :: forall a b s t.
(forall (f :: * -> *).
 Applicative f =>
 (a %1 -> f b) -> s %1 -> f t)
-> Traversal s t a b
traversal forall (f :: * -> *). Applicative f => (a %1 -> f b) -> s %1 -> f t
trav = (arr a b -> arr s t) %1 -> Optic_ arr s t a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical ((arr a b -> arr s t) %1 -> Optic_ arr s t a b)
%1 -> (arr a b -> arr s t) %1 -> Optic_ arr s t a b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (forall (f :: * -> *).
 Applicative f =>
 (a %1 -> f b) -> s %1 -> f t)
-> arr a b -> arr s t
forall (arr :: * -> * -> *) s t a b.
Wandering arr =>
(forall (f :: * -> *).
 Applicative f =>
 (a %1 -> f b) -> s %1 -> f t)
-> arr a b -> arr s t
wander forall (f :: * -> *). Applicative f => (a %1 -> f b) -> s %1 -> f t
trav

_1 :: Lens (a,c) (b,c) a b
_1 :: forall a c b. Lens (a, c) (b, c) a b
_1 = (arr a b -> arr (a, c) (b, c)) -> Optic_ arr (a, c) (b, c) a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical arr a b -> arr (a, c) (b, c)
forall (m :: * -> * -> *) u (arr :: * -> * -> *) a b c.
Strong m u arr =>
arr a b -> arr (m a c) (m b c)
first

_2 :: Lens (c,a) (c,b) a b
_2 :: forall c a b. Lens (c, a) (c, b) a b
_2 = (arr a b -> arr (c, a) (c, b)) -> Optic_ arr (c, a) (c, b) a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical arr a b -> arr (c, a) (c, b)
forall (m :: * -> * -> *) u (arr :: * -> * -> *) b c a.
Strong m u arr =>
arr b c -> arr (m a b) (m a c)
second

_Left :: Prism (Either a c) (Either b c) a b
_Left :: forall a c b. Prism (Either a c) (Either b c) a b
_Left = (arr a b -> arr (Either a c) (Either b c))
-> Optic_ arr (Either a c) (Either b c) a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical arr a b -> arr (Either a c) (Either b c)
forall (m :: * -> * -> *) u (arr :: * -> * -> *) a b c.
Strong m u arr =>
arr a b -> arr (m a c) (m b c)
first

_Right :: Prism (Either c a) (Either c b) a b
_Right :: forall c a b. Prism (Either c a) (Either c b) a b
_Right = (arr a b -> arr (Either c a) (Either c b))
-> Optic_ arr (Either c a) (Either c b) a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical arr a b -> arr (Either c a) (Either c b)
forall (m :: * -> * -> *) u (arr :: * -> * -> *) b c a.
Strong m u arr =>
arr b c -> arr (m a b) (m a c)
second

_Just :: Prism (Maybe a) (Maybe b) a b
_Just :: forall a b. Prism (Maybe a) (Maybe b) a b
_Just = (b %1 -> Maybe b)
-> (Maybe a %1 -> Either (Maybe b) a)
-> Prism (Maybe a) (Maybe b) a b
forall b t s a.
(b %1 -> t) -> (s %1 -> Either t a) -> Prism s t a b
prism b %1 -> Maybe b
forall a. a -> Maybe a
Just (Either (Maybe b) a
-> (a %1 -> Either (Maybe b) a) -> Maybe a %1 -> Either (Maybe b) a
forall b a. b -> (a %1 -> b) -> Maybe a %1 -> b
maybe (Maybe b -> Either (Maybe b) a
forall a b. a -> Either a b
Left Maybe b
forall a. Maybe a
Nothing) a %1 -> Either (Maybe b) a
forall a b. b -> Either a b
Right)

_Nothing :: Prism' (Maybe a) ()
_Nothing :: forall a. Prism' (Maybe a) ()
_Nothing = (() %1 -> Maybe a)
-> (Maybe a %1 -> Either (Maybe a) ())
-> Prism (Maybe a) (Maybe a) () ()
forall b t s a.
(b %1 -> t) -> (s %1 -> Either t a) -> Prism s t a b
prism (\() -> Maybe a
forall a. Maybe a
Nothing) Maybe a %1 -> Either (Maybe a) ()
forall a b. a -> Either a b
Left

traversed :: Traversable t => Traversal (t a) (t b) a b
traversed :: forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed = (arr a b -> arr (t a) (t b)) %1 -> Optic_ arr (t a) (t b) a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical ((arr a b -> arr (t a) (t b)) %1 -> Optic_ arr (t a) (t b) a b)
%1 -> (arr a b -> arr (t a) (t b)) %1 -> Optic_ arr (t a) (t b) a b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ (forall (f :: * -> *).
 Applicative f =>
 (a %1 -> f b) -> t a %1 -> f (t b))
-> arr a b -> arr (t a) (t b)
forall (arr :: * -> * -> *) s t a b.
Wandering arr =>
(forall (f :: * -> *).
 Applicative f =>
 (a %1 -> f b) -> s %1 -> f t)
-> arr a b -> arr s t
wander forall (f :: * -> *).
Applicative f =>
(a %1 -> f b) -> t a %1 -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a %1 -> f b) -> t a %1 -> f (t b)
traverse

over :: Optic_ LinearArrow s t a b -> (a %1-> b) -> s %1-> t
over :: forall s t a b.
Optic_ LinearArrow s t a b -> (a %1 -> b) -> s %1 -> t
over (Optical LinearArrow a b -> LinearArrow s t
l) a %1 -> b
f = LinearArrow s t %1 -> s %1 -> t
forall a b. LinearArrow a b %1 -> a %1 -> b
getLA (LinearArrow a b -> LinearArrow s t
l ((a %1 -> b) -> LinearArrow a b
forall a b. (a %1 -> b) -> LinearArrow a b
LA a %1 -> b
f))

traverseOf :: Optic_ (Linear.Kleisli f) s t a b -> (a %1-> f b) -> s %1-> f t
traverseOf :: forall (f :: * -> *) s t a b.
Optic_ (Kleisli f) s t a b -> (a %1 -> f b) -> s %1 -> f t
traverseOf (Optical Kleisli f a b -> Kleisli f s t
l) a %1 -> f b
f = Kleisli f s t -> s %1 -> f t
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
Linear.runKleisli (Kleisli f a b -> Kleisli f s t
l ((a %1 -> f b) -> Kleisli f a b
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Linear.Kleisli a %1 -> f b
f))

toListOf :: Optic_ (NonLinear.Kleisli (Const [a])) s t a b -> s -> [a]
toListOf :: forall a s t b. Optic_ (Kleisli (Const [a])) s t a b -> s -> [a]
toListOf Optic_ (Kleisli (Const [a])) s t a b
l = Optic_ (Kleisli (Const [a])) s t a b -> (a -> [a]) -> s -> [a]
forall r s t a b.
Optic_ (Kleisli (Const r)) s t a b -> (a -> r) -> s -> r
gets Optic_ (Kleisli (Const [a])) s t a b
l (\a
a -> [a
a])

get :: Optic_ (NonLinear.Kleisli (Const a)) s t a b -> s -> a
get :: forall a s t b. Optic_ (Kleisli (Const a)) s t a b -> s -> a
get Optic_ (Kleisli (Const a)) s t a b
l = Optic_ (Kleisli (Const a)) s t a b -> (a -> a) -> s -> a
forall r s t a b.
Optic_ (Kleisli (Const r)) s t a b -> (a -> r) -> s -> r
gets Optic_ (Kleisli (Const a)) s t a b
l a -> a
forall a. a -> a
Prelude.id

gets :: Optic_ (NonLinear.Kleisli (Const r)) s t a b -> (a -> r) -> s -> r
gets :: forall r s t a b.
Optic_ (Kleisli (Const r)) s t a b -> (a -> r) -> s -> r
gets (Optical Kleisli (Const r) a b -> Kleisli (Const r) s t
l) a -> r
f s
s = Const r t %1 -> r
forall a b. Const a b %1 -> a
getConst' (Kleisli (Const r) s t -> s -> Const r t
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
NonLinear.runKleisli (Kleisli (Const r) a b -> Kleisli (Const r) s t
l ((a -> Const r b) -> Kleisli (Const r) a b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
NonLinear.Kleisli (r -> Const r b
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. a -> r
f))) s
s)

set :: Optic_ (->) s t a b -> b -> s -> t
set :: forall s t a b. Optic_ (->) s t a b -> b -> s -> t
set (Optical (a -> b) -> s -> t
l) b
x = (a -> b) -> s -> t
l (b %1 -> a -> b
forall a b. a %1 -> b -> a
const b
x)

setSwap :: Optic_ (Linear.Kleisli (Compose (LinearArrow b) ((,) a))) s t a b -> s %1-> b %1-> (a, t)
setSwap :: forall b a s t.
Optic_ (Kleisli (Compose (LinearArrow b) ((,) a))) s t a b
-> s %1 -> b %1 -> (a, t)
setSwap (Optical Kleisli (Compose (LinearArrow b) ((,) a)) a b
-> Kleisli (Compose (LinearArrow b) ((,) a)) s t
l) s
s = LinearArrow b (a, t) %1 -> b %1 -> (a, t)
forall a b. LinearArrow a b %1 -> a %1 -> b
getLA (Compose (LinearArrow b) ((,) a) t %1 -> LinearArrow b (a, t)
forall (f :: * -> *) (g :: * -> *) a. Compose f g a %1 -> f (g a)
getCompose (Kleisli (Compose (LinearArrow b) ((,) a)) s t
-> s %1 -> Compose (LinearArrow b) ((,) a) t
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
Linear.runKleisli (Kleisli (Compose (LinearArrow b) ((,) a)) a b
-> Kleisli (Compose (LinearArrow b) ((,) a)) s t
l ((a %1 -> Compose (LinearArrow b) ((,) a) b)
-> Kleisli (Compose (LinearArrow b) ((,) a)) a b
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Linear.Kleisli (\a
a -> LinearArrow b (a, b) %1 -> Compose (LinearArrow b) ((,) a) b
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((b %1 -> (a, b)) %1 -> LinearArrow b (a, b)
forall a b. (a %1 -> b) -> LinearArrow a b
LA (\b
b -> (a
a,b
b)))))) s
s))

match :: Optic_ (Market a b) s t a b -> s %1-> Either t a
match :: forall a b s t. Optic_ (Market a b) s t a b -> s %1 -> Either t a
match (Optical Market a b a b -> Market a b s t
l) = (b %1 -> t, s %1 -> Either t a) -> s %1 -> Either t a
forall a b. (a, b) -> b
Prelude.snd (Market a b s t %1 -> (b %1 -> t, s %1 -> Either t a)
forall a b s t.
Market a b s t %1 -> (b %1 -> t, s %1 -> Either t a)
runMarket (Market a b a b -> Market a b s t
l ((b %1 -> b) -> (a %1 -> Either b a) -> Market a b a b
forall a b s t.
(b %1 -> t) -> (s %1 -> Either t a) -> Market a b s t
Market b %1 -> b
forall a. a %1 -> a
id a %1 -> Either b a
forall a b. b -> Either a b
Right)))

build :: Optic_ (Linear.CoKleisli (Const b)) s t a b -> b %1-> t
build :: forall b s t a. Optic_ (CoKleisli (Const b)) s t a b -> b %1 -> t
build (Optical CoKleisli (Const b) a b -> CoKleisli (Const b) s t
l) b
x = CoKleisli (Const b) s t -> Const b s %1 -> t
forall (w :: * -> *) a b. CoKleisli w a b -> w a %1 -> b
Linear.runCoKleisli (CoKleisli (Const b) a b -> CoKleisli (Const b) s t
l ((Const b a %1 -> b) -> CoKleisli (Const b) a b
forall (w :: * -> *) a b. (w a %1 -> b) -> CoKleisli w a b
Linear.CoKleisli Const b a %1 -> b
forall a b. Const a b %1 -> a
getConst')) (b %1 -> Const b s
forall {k} a (b :: k). a -> Const a b
Const b
x)

-- XXX: move this to Prelude
-- | Linearly typed patch for the newtype deconstructor. (Temporary until
-- inference will get this from the newtype declaration.)
getConst' :: Const a b %1-> a
getConst' :: forall a b. Const a b %1 -> a
getConst' (Const a
x) = a
x

lengthOf :: MultIdentity r => Optic_ (NonLinear.Kleisli (Const (Adding r))) s t a b -> s -> r
lengthOf :: forall r s t a b.
MultIdentity r =>
Optic_ (Kleisli (Const (Adding r))) s t a b -> s -> r
lengthOf Optic_ (Kleisli (Const (Adding r))) s t a b
l s
s = Adding r %1 -> r
forall a. Adding a %1 -> a
getAdded (Optic_ (Kleisli (Const (Adding r))) s t a b
-> (a -> Adding r) -> s -> Adding r
forall r s t a b.
Optic_ (Kleisli (Const r)) s t a b -> (a -> r) -> s -> r
gets Optic_ (Kleisli (Const (Adding r))) s t a b
l (Adding r %1 -> a -> Adding r
forall a b. a %1 -> b -> a
const (r -> Adding r
forall a. a -> Adding a
Adding r
forall a. MultIdentity a => a
one)) s
s)

-- XXX: the below two functions will be made redundant with multiplicity
-- polymorphism on over and traverseOfU
overU :: Optic_ (->) s t a b -> (a -> b) -> s -> t
overU :: forall s t a b. Optic_ (->) s t a b -> (a -> b) -> s -> t
overU (Optical (a -> b) -> s -> t
l) a -> b
f = (a -> b) -> s -> t
l a -> b
f

traverseOfU :: Optic_ (NonLinear.Kleisli f) s t a b -> (a -> f b) -> s -> f t
traverseOfU :: forall (f :: * -> *) s t a b.
Optic_ (Kleisli f) s t a b -> (a -> f b) -> s -> f t
traverseOfU (Optical Kleisli f a b -> Kleisli f s t
l) a -> f b
f = Kleisli f s t -> s -> f t
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
NonLinear.runKleisli (Kleisli f a b -> Kleisli f s t
l ((a -> f b) -> Kleisli f a b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
NonLinear.Kleisli a -> f b
f))

iso :: (s %1-> a) -> (b %1-> t) -> Iso s t a b
iso :: forall s a b t. (s %1 -> a) -> (b %1 -> t) -> Iso s t a b
iso s %1 -> a
f b %1 -> t
g = (arr a b -> arr s t) -> Optic_ arr s t a b
forall (arr :: * -> * -> *) s t a b.
(arr a b -> arr s t) -> Optic_ arr s t a b
Optical ((s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
forall (arr :: * -> * -> *) s a b t.
Profunctor arr =>
(s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
dimap s %1 -> a
f b %1 -> t
g)

withIso :: Optic_ (Exchange a b) s t a b -> ((s %1-> a) -> (b %1-> t) -> r) -> r
withIso :: forall a b s t r.
Optic_ (Exchange a b) s t a b
-> ((s %1 -> a) -> (b %1 -> t) -> r) -> r
withIso (Optical Exchange a b a b -> Exchange a b s t
l) (s %1 -> a) -> (b %1 -> t) -> r
f = (s %1 -> a) -> (b %1 -> t) -> r
f s %1 -> a
fro b %1 -> t
to
  where Exchange s %1 -> a
fro b %1 -> t
to = Exchange a b a b -> Exchange a b s t
l ((a %1 -> a) -> (b %1 -> b) -> Exchange a b a b
forall a b s t. (s %1 -> a) -> (b %1 -> t) -> Exchange a b s t
Exchange a %1 -> a
forall a. a %1 -> a
id b %1 -> b
forall a. a %1 -> a
id)

withPrism :: Optic_ (Market a b) s t a b -> ((b %1-> t) -> (s %1-> Either t a) -> r) -> r
withPrism :: forall a b s t r.
Optic_ (Market a b) s t a b
-> ((b %1 -> t) -> (s %1 -> Either t a) -> r) -> r
withPrism (Optical Market a b a b -> Market a b s t
l) (b %1 -> t) -> (s %1 -> Either t a) -> r
f = (b %1 -> t) -> (s %1 -> Either t a) -> r
f b %1 -> t
b s %1 -> Either t a
m
  where Market b %1 -> t
b s %1 -> Either t a
m = Market a b a b -> Market a b s t
l ((b %1 -> b) -> (a %1 -> Either b a) -> Market a b a b
forall a b s t.
(b %1 -> t) -> (s %1 -> Either t a) -> Market a b s t
Market b %1 -> b
forall a. a %1 -> a
id a %1 -> Either b a
forall a b. b -> Either a b
Right)

-- XXX: probably a direct implementation would be better
withLens
  :: Optic_ (Linear.Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
  -> (forall c. (s %1-> (c, a)) -> ((c, b) %1-> t) -> r)
  -> r
withLens :: forall a b s t r.
Optic_ (Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
-> (forall c. (s %1 -> (c, a)) -> ((c, b) %1 -> t) -> r) -> r
withLens Optic_ (Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
l forall c. (s %1 -> (c, a)) -> ((c, b) %1 -> t) -> r
k = (s %1 -> (b %1 -> t, a)) -> ((b %1 -> t, b) %1 -> t) -> r
forall c. (s %1 -> (c, a)) -> ((c, b) %1 -> t) -> r
k ((a, b %1 -> t) %1 -> (b %1 -> t, a)
forall (m :: * -> * -> *) u a b.
SymmetricMonoidal m u =>
m a b %1 -> m b a
Bifunctor.swap ((a, b %1 -> t) %1 -> (b %1 -> t, a))
%1 -> (s %1 -> (a, b %1 -> t)) %1 -> s %1 -> (b %1 -> t, a)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (Optic_ (Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
-> s %1 -> (a, b %1 -> t)
forall a b s t.
Optic_ (Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
-> s %1 -> (a, b %1 -> t)
reifyLens Optic_ (Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
l)) (((b %1 -> t) %1 -> b %1 -> t) %1 -> (b %1 -> t, b) %1 -> t
forall a b c. (a %1 -> b %1 -> c) %1 -> (a, b) %1 -> c
uncurry (b %1 -> t) %1 -> b %1 -> t
forall a b. (a %1 -> b) %1 -> a %1 -> b
($))

reifyLens :: Optic_ (Linear.Kleisli (Compose ((,) a) (FUN 'One b))) s t a b -> s %1-> (a, b %1-> t)
reifyLens :: forall a b s t.
Optic_ (Kleisli (Compose ((,) a) (FUN 'One b))) s t a b
-> s %1 -> (a, b %1 -> t)
reifyLens (Optical Kleisli (Compose ((,) a) (FUN 'One b)) a b
-> Kleisli (Compose ((,) a) (FUN 'One b)) s t
l) s
s = Compose ((,) a) (FUN 'One b) t %1 -> (a, b %1 -> t)
forall (f :: * -> *) (g :: * -> *) a. Compose f g a %1 -> f (g a)
getCompose (Kleisli (Compose ((,) a) (FUN 'One b)) s t
-> s %1 -> Compose ((,) a) (FUN 'One b) t
forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
Linear.runKleisli (Kleisli (Compose ((,) a) (FUN 'One b)) a b
-> Kleisli (Compose ((,) a) (FUN 'One b)) s t
l ((a %1 -> Compose ((,) a) (FUN 'One b) b)
-> Kleisli (Compose ((,) a) (FUN 'One b)) a b
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Linear.Kleisli (\a
a -> (a, b %1 -> b) %1 -> Compose ((,) a) (FUN 'One b) b
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (a
a, b %1 -> b
forall a. a %1 -> a
id)))) s
s)

-- linear variant of getCompose
getCompose :: Compose f g a %1-> f (g a)
getCompose :: forall (f :: * -> *) (g :: * -> *) a. Compose f g a %1 -> f (g a)
getCompose (Compose f (g a)
x) = f (g a)
x