{-# LANGUAGE RankNTypes #-} module Control.Foldl.Optics where import Data.Profunctor type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t) type Prism' s a = Prism s s a a prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b prism :: 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 = forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap s -> Either t a seta (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap b -> t bt)) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (p :: * -> * -> *) a b c. Choice p => p a b -> p (Either c a) (Either c b) right' {-# INLINE prism #-} _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 = 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 forall a b. (a -> b) -> a -> b $ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall a b. b -> Either a b Right (forall a b. a -> Either a b Left forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. b -> Either a b Right) {-# INLINE _Left #-} _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 = 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 forall a b. (a -> b) -> a -> b $ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall a b. a -> Either a b Left forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. a -> Either a b Left) forall a b. b -> Either a b Right {-# INLINE _Right #-}