{-# LANGUAGE DeriveFunctor #-}
module Proton.Iso where

import Data.Profunctor
import Proton.Getter
import Proton.Review

type Iso s t a b = forall p. Profunctor p => p a b -> p s t
type Iso' s a = Iso s s a a

iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso = (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

from :: Iso s t a b -> Iso b a t s
from :: Iso s t a b -> Iso b a t s
from i :: Iso s t a b
i = 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
i (((s -> a) -> (b -> t) -> p t s -> p b a) -> p t s -> p b a)
-> ((s -> a) -> (b -> t) -> p t s -> p b a) -> p t s -> p b a
forall a b. (a -> b) -> a -> b
$ ((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 s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso

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 i :: Iso s t a b
i handler :: (s -> a) -> (b -> t) -> r
handler =
    case Exchange a b a b -> Exchange a b s t
Iso s t a b
i ((a -> a) -> (b -> b) -> Exchange a b a b
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
forall a. a -> a
id b -> b
forall a. a -> a
id) of
        Exchange f :: s -> a
f g :: b -> t
g -> (s -> a) -> (b -> t) -> r
handler s -> a
f b -> t
g

under :: Iso s t a b -> (t -> s) -> b -> a
under :: Iso s t a b -> (t -> s) -> b -> a
under i :: Iso s t a b
i ts :: t -> s
ts b :: b
b = Iso s t a b -> ((s -> a) -> (b -> t) -> a) -> 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) -> (b -> t) -> a) -> a)
-> ((s -> a) -> (b -> t) -> a) -> a
forall a b. (a -> b) -> a -> b
$ \sa :: s -> a
sa bt :: b -> t
bt -> (s -> a
sa (s -> a) -> (b -> s) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> s
ts (t -> s) -> (b -> t) -> b -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> t
bt (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
$ b
b)

mapping :: (Functor f, Functor g) => Iso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping :: Iso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping i :: Iso s t a b
i = (f s -> f a) -> (g b -> g t) -> p (f a) (g b) -> p (f s) (g t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((s -> a) -> f s -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic (Forget a) s t a b -> s -> a
forall a s t b. Optic (Forget a) s t a b -> s -> a
view Optic (Forget a) s t a b
Iso s t a b
i)) ((b -> t) -> g b -> g t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tagged a b -> Tagged s t) -> b -> t
forall k1 k2 (a :: k1) b (s :: k2) t.
(Tagged a b -> Tagged s t) -> b -> t
review Tagged a b -> Tagged s t
Iso s t a b
i))

involuted :: (a -> a) -> Iso' a a
involuted :: (a -> a) -> Iso' a a
involuted f :: 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

data Exchange a b s t =
    Exchange (s -> a) (b -> t)
  deriving a -> Exchange a b s b -> Exchange a b s a
(a -> b) -> Exchange a b s a -> Exchange a b s b
(forall a b. (a -> b) -> Exchange a b s a -> Exchange a b s b)
-> (forall a b. a -> Exchange a b s b -> Exchange a b s a)
-> Functor (Exchange a b s)
forall a b. a -> Exchange a b s b -> Exchange a b s a
forall a b. (a -> b) -> Exchange a b s a -> Exchange a b s b
forall a b s a b. a -> Exchange a b s b -> Exchange a b s a
forall a b s a b. (a -> b) -> Exchange a b s a -> Exchange a b s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Exchange a b s b -> Exchange a b s a
$c<$ :: forall a b s a b. a -> Exchange a b s b -> Exchange a b s a
fmap :: (a -> b) -> Exchange a b s a -> Exchange a b s b
$cfmap :: forall a b s a b. (a -> b) -> Exchange a b s a -> Exchange a b s b
Functor

instance Profunctor (Exchange a b) where
  dimap :: (a -> b) -> (c -> d) -> Exchange a b b c -> Exchange a b a d
dimap f' :: a -> b
f' g' :: c -> d
g' (Exchange f :: b -> a
f g :: b -> c
g) = (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
f (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
g)