{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Generics.Internal.Profunctor.Prism where
import Data.Bifunctor (bimap)
import Data.Profunctor (Choice(..), Profunctor(..))
import Data.Tagged
import Data.Profunctor.Unsafe ((#.), (.#))
import GHC.Generics
import Data.Coerce
type APrism s t a b = Market a b a b -> Market a b s t
type Prism s t a b
= forall p . (Choice p) => p a b -> p s t
type Prism' s a = forall p . (Choice p) => p a a -> p s s
left :: Prism ((a :+: c) x) ((b :+: c) x) (a x) (b x)
left :: p (a x) (b x) -> p ((:+:) a c x) ((:+:) b c x)
left = (b x -> (:+:) b c x)
-> ((:+:) a c x -> Either ((:+:) b c x) (a x))
-> Prism ((:+:) a c x) ((:+:) b c x) (a x) (b x)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b x -> (:+:) b c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (((:+:) a c x -> Either ((:+:) b c x) (a x))
-> p (a x) (b x) -> p ((:+:) a c x) ((:+:) b c x))
-> ((:+:) a c x -> Either ((:+:) b c x) (a x))
-> p (a x) (b x)
-> p ((:+:) a c x) ((:+:) b c x)
forall a b. (a -> b) -> a -> b
$ (a x -> Either ((:+:) b c x) (a x))
-> (c x -> Either ((:+:) b c x) (a x))
-> (:+:) a c x
-> Either ((:+:) b c x) (a x)
forall (a :: * -> *) x c (b :: * -> *).
(a x -> c) -> (b x -> c) -> (:+:) a b x -> c
gsum a x -> Either ((:+:) b c x) (a x)
forall a b. b -> Either a b
Right ((:+:) b c x -> Either ((:+:) b c x) (a x)
forall a b. a -> Either a b
Left ((:+:) b c x -> Either ((:+:) b c x) (a x))
-> (c x -> (:+:) b c x) -> c x -> Either ((:+:) b c x) (a x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c x -> (:+:) b c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1)
right :: Prism ((a :+: b) x) ((a :+: c) x) (b x) (c x)
right :: p (b x) (c x) -> p ((:+:) a b x) ((:+:) a c x)
right = (c x -> (:+:) a c x)
-> ((:+:) a b x -> Either ((:+:) a c x) (b x))
-> Prism ((:+:) a b x) ((:+:) a c x) (b x) (c x)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism c x -> (:+:) a c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (((:+:) a b x -> Either ((:+:) a c x) (b x))
-> p (b x) (c x) -> p ((:+:) a b x) ((:+:) a c x))
-> ((:+:) a b x -> Either ((:+:) a c x) (b x))
-> p (b x) (c x)
-> p ((:+:) a b x) ((:+:) a c x)
forall a b. (a -> b) -> a -> b
$ (a x -> Either ((:+:) a c x) (b x))
-> (b x -> Either ((:+:) a c x) (b x))
-> (:+:) a b x
-> Either ((:+:) a c x) (b x)
forall (a :: * -> *) x c (b :: * -> *).
(a x -> c) -> (b x -> c) -> (:+:) a b x -> c
gsum ((:+:) a c x -> Either ((:+:) a c x) (b x)
forall a b. a -> Either a b
Left ((:+:) a c x -> Either ((:+:) a c x) (b x))
-> (a x -> (:+:) a c x) -> a x -> Either ((:+:) a c x) (b x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a x -> (:+:) a c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) b x -> Either ((:+:) a c x) (b x)
forall a b. b -> Either a b
Right
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism bt :: b -> t
bt seta :: s -> Either t a
seta eta :: p a b
eta = (s -> Either t a)
-> (Either t b -> t) -> p (Either t a) (Either t b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either t a
seta ((t -> t) -> (b -> t) -> Either t b -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> t
forall a. a -> a
id b -> t
bt) (p a b -> p (Either t a) (Either t b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p a b
eta)
_Left :: Prism (Either a c) (Either b c) a b
_Left :: p a b -> p (Either a c) (Either b c)
_Left = p a b -> p (Either a c) (Either b c)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left'
_Right :: Prism (Either c a) (Either c b) a b
_Right :: p a b -> p (Either c a) (Either c b)
_Right = p a b -> p (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
prismPRavel :: APrism s t a b -> Prism s t a b
prismPRavel :: APrism s t a b -> Prism s t a b
prismPRavel l :: APrism s t a b
l pab :: p a b
pab = (Market a b s t -> Prism s t a b
forall a b s t. Market a b s t -> Prism s t a b
prism2prismp (Market a b s t -> Prism s t a b)
-> Market a b s t -> Prism s t a b
forall a b. (a -> b) -> a -> b
$ APrism s t a b
l Market a b a b
forall a b. Market a b a b
idPrism) p a b
pab
build :: (Tagged b b -> Tagged t t) -> b -> t
build :: (Tagged b b -> Tagged t t) -> b -> t
build p :: Tagged b b -> Tagged t t
p = Tagged t t -> t
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged t t -> t) -> (Tagged b b -> Tagged t t) -> Tagged b b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Tagged b b -> Tagged t t
p (Tagged b b -> t) -> (b -> Tagged b b) -> b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# b -> Tagged b b
forall k (s :: k) b. b -> Tagged s b
Tagged
match :: Prism s t a b -> s -> Either t a
match :: Prism s t a b -> s -> Either t a
match k :: Prism s t a b
k = APrism s t a b
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
Prism s t a b
k (((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s -> Either t a)
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall a b. (a -> b) -> a -> b
$ \_ _match :: s -> Either t a
_match -> s -> Either t a
_match
without' :: Prism s t a b -> Prism s t c d -> Prism s t (Either a c) (Either b d)
without' :: Prism s t a b
-> Prism s t c d -> Prism s t (Either a c) (Either b d)
without' k :: Prism s t a b
k =
APrism s t a b
-> ((b -> t)
-> (s -> Either t a)
-> APrism s t c d
-> p (Either a c) (Either b d)
-> p s t)
-> APrism s t c d
-> p (Either a c) (Either b d)
-> p s t
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
Prism s t a b
k (((b -> t)
-> (s -> Either t a)
-> APrism s t c d
-> p (Either a c) (Either b d)
-> p s t)
-> Prism s t c d -> p (Either a c) (Either b d) -> p s t)
-> ((b -> t)
-> (s -> Either t a)
-> APrism s t c d
-> p (Either a c) (Either b d)
-> p s t)
-> Prism s t c d
-> p (Either a c) (Either b d)
-> p s t
forall a b. (a -> b) -> a -> b
$ \bt :: b -> t
bt _ k' :: APrism s t c d
k' ->
APrism s t c d
-> ((d -> t)
-> (s -> Either t c) -> p (Either a c) (Either b d) -> p s t)
-> p (Either a c) (Either b d)
-> p s t
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t c d
k' (((d -> t)
-> (s -> Either t c) -> p (Either a c) (Either b d) -> p s t)
-> p (Either a c) (Either b d) -> p s t)
-> ((d -> t)
-> (s -> Either t c) -> p (Either a c) (Either b d) -> p s t)
-> p (Either a c) (Either b d)
-> p s t
forall a b. (a -> b) -> a -> b
$ \dt :: d -> t
dt setc :: s -> Either t c
setc ->
(Either b d -> t)
-> (s -> Either t (Either a c))
-> Prism s t (Either a c) (Either b d)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> t) -> (d -> t) -> Either b d -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> t
bt d -> t
dt) ((s -> Either t (Either a c))
-> p (Either a c) (Either b d) -> p s t)
-> (s -> Either t (Either a c))
-> p (Either a c) (Either b d)
-> p s t
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> (c -> Either a c) -> Either t c -> Either t (Either a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Either a c
forall a b. b -> Either a b
Right (s -> Either t c
setc s
s)
{-# INLINE without' #-}
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism k :: APrism s t a b
k f :: (b -> t) -> (s -> Either t a) -> r
f = case APrism s t a b
k Market a b a b
forall a b. Market a b a b
idPrism of
Market bt :: b -> t
bt seta :: s -> Either t a
seta -> (b -> t) -> (s -> Either t a) -> r
f b -> t
bt s -> Either t a
seta
prism2prismp :: Market a b s t -> Prism s t a b
prism2prismp :: Market a b s t -> Prism s t a b
prism2prismp (Market bt :: b -> t
bt seta :: s -> Either t a
seta) = (b -> t) -> (s -> Either t a) -> Prism s t a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> t
bt s -> Either t a
seta
idPrism :: Market a b a b
idPrism :: Market a b a b
idPrism = (b -> b) -> (a -> Either b a) -> Market a b a b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> b
forall a. a -> a
id a -> Either b a
forall a b. b -> Either a b
Right
gsum :: (a x -> c) -> (b x -> c) -> ((a :+: b) x) -> c
gsum :: (a x -> c) -> (b x -> c) -> (:+:) a b x -> c
gsum f :: a x -> c
f _ (L1 x :: a x
x) = a x -> c
f a x
x
gsum _ g :: b x -> c
g (R1 y :: b x
y) = b x -> c
g b x
y
plus :: (a -> b) -> (c -> d) -> Either a c -> Either b d
plus :: (a -> b) -> (c -> d) -> Either a c -> Either b d
plus = (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
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 bt :: b -> a
bt seta :: s -> Either a a
seta) = (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
bt) ((a -> Either b a) -> (a -> Either b a) -> Either a a -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b a
forall a b. a -> Either a b
Left (b -> Either b a) -> (a -> b) -> a -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) a -> Either b a
forall a b. b -> Either a b
Right (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
seta)
{-# INLINE fmap #-}
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 bt :: b -> c
bt seta :: b -> Either c a
seta) = (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
bt) ((c -> Either d a) -> (a -> Either d a) -> Either c a -> Either d a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (d -> Either d a
forall a b. a -> Either a b
Left (d -> Either d a) -> (c -> d) -> c -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) a -> Either d a
forall a b. b -> Either a b
Right (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
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE dimap #-}
lmap :: (a -> b) -> Market a b b c -> Market a b a c
lmap f :: a -> b
f (Market bt :: b -> c
bt seta :: b -> Either c a
seta) = (b -> c) -> (a -> Either c a) -> Market a b a c
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> c
bt (b -> Either c a
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE lmap #-}
rmap :: (b -> c) -> Market a b a b -> Market a b a c
rmap f :: b -> c
f (Market bt :: b -> b
bt seta :: a -> Either b a
seta) = (b -> c) -> (a -> Either c a) -> Market a b a c
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> c
f (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((b -> Either c a) -> (a -> Either c a) -> Either b a -> Either c a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (c -> Either c a
forall a b. a -> Either a b
Left (c -> Either c a) -> (b -> c) -> b -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) a -> Either c a
forall a b. b -> Either a b
Right (Either b a -> Either c a) -> (a -> Either b a) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
seta)
{-# INLINE rmap #-}
( #. ) _ = Market a b a b -> Market a b a c
forall a b. Coercible a b => a -> b
coerce
{-# INLINE ( #. ) #-}
( .# ) p :: Market a b b c
p _ = Market a b b c -> Market a b a c
forall a b. Coercible a b => a -> b
coerce Market a b b c
p
{-# INLINE ( .# ) #-}
instance Choice (Market a b) where
left' :: Market a b a b -> Market a b (Either a c) (Either b c)
left' (Market bt :: b -> b
bt seta :: a -> Either b a
seta) = (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
bt) ((Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c))
-> (Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \case
Left s :: a
s -> case a -> Either b a
seta a
s of
Left t :: b
t -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (b -> Either b c
forall a b. a -> Either a b
Left b
t)
Right a :: a
a -> a -> Either (Either b c) a
forall a b. b -> Either a b
Right a
a
Right c :: c
c -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (c -> Either b c
forall a b. b -> Either a b
Right c
c)
{-# INLINE left' #-}