module Data.Market where

import Data.Profunctor
import Data.Bifunctor

-- | The `Market` profunctor characterizes a `Prism`.
data Market a b s t = Market (b -> t) (s -> Either t a)

instance Functor (Market a b s) where
  fmap :: (a -> b) -> Market a b s a -> Market a b s b
fmap f :: a -> b
f (Market proj :: b -> a
proj match :: s -> Either a a
match) = (b -> b) -> (s -> Either b a) -> Market a b s b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
proj) ((a -> b) -> Either a a -> Either b a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f (Either a a -> Either b a) -> (s -> Either a a) -> s -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either a a
match)

instance Profunctor (Market a b) where
  dimap :: (a -> b) -> (c -> d) -> Market a b b c -> Market a b a d
dimap f :: a -> b
f g :: c -> d
g (Market a :: b -> c
a b :: b -> Either c a
b) = (b -> d) -> (a -> Either d a) -> Market a b a d
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
a) ((c -> d) -> Either c a -> Either d a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first c -> d
g (Either c a -> Either d a) -> (a -> Either c a) -> a -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
b (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Choice (Market a b) where
  left' :: Market a b a b -> Market a b (Either a c) (Either b c)
left' (Market x :: b -> b
x y :: a -> Either b a
y) =
    (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> (b -> b) -> b -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
x) ((a -> Either (Either b c) a)
-> (c -> Either (Either b c) a)
-> Either a c
-> Either (Either b c) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b c) -> Either b a -> Either (Either b c) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either b c
forall a b. a -> Either a b
Left (Either b a -> Either (Either b c) a)
-> (a -> Either b a) -> a -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
y) (Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (Either b c -> Either (Either b c) a)
-> (c -> Either b c) -> c -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right))
  right' :: Market a b a b -> Market a b (Either c a) (Either c b)
right' (Market x :: b -> b
x y :: a -> Either b a
y) =
    (b -> Either c b)
-> (Either c a -> Either (Either c b) a)
-> Market a b (Either c a) (Either c b)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> (b -> b) -> b -> Either c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
x) ((c -> Either (Either c b) a)
-> (a -> Either (Either c b) a)
-> Either c a
-> Either (Either c b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (Either c b -> Either (Either c b) a)
-> (c -> Either c b) -> c -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) ((b -> Either c b) -> Either b a -> Either (Either c b) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either c b
forall a b. b -> Either a b
Right (Either b a -> Either (Either c b) a)
-> (a -> Either b a) -> a -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
y))