module Data.Either.Optics
( _Left
, _Right
)
where
import Optics.Prism
_Left :: Prism (Either a b) (Either c b) a c
_Left :: forall a b c. Prism (Either a b) (Either c b) a c
_Left =
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
forall a b. a -> Either a b
Left
(\ Either a b
x ->
case Either a b
x of
Left a
y -> forall a b. b -> Either a b
Right a
y
Right b
y -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
y)
)
{-# INLINE _Left #-}
_Right :: Prism (Either a b) (Either a c) b c
_Right :: forall a b c. Prism (Either a b) (Either a c) b c
_Right =
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
forall a b. b -> Either a b
Right
(\ Either a b
x ->
case Either a b
x of
Left a
y -> forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left a
y)
Right b
y -> forall a b. b -> Either a b
Right b
y
)
{-# INLINE _Right #-}