{-# LANGUAGE InstanceSigs #-} module Proton.Coalgebraic where import Proton.Types import Data.Profunctor import Proton.Prisms import Proton.Review type Coalgebraic s t a b = forall p. MChoice p => Optic p s t a b type Coalgebraic' s a = Coalgebraic s s a a swapEither :: Either a b -> Either b a swapEither :: Either a b -> Either b a swapEither (Left a :: a a) = a -> Either b a forall a b. b -> Either a b Right a a swapEither (Right a :: b a) = b -> Either b a forall a b. a -> Either a b Left b a class Profunctor p => MChoice p where mleft' :: p a b -> p (Either a m) (Either b m) mleft' = (Either a m -> Either m a) -> (Either m b -> Either b m) -> p (Either m a) (Either m b) -> p (Either a m) (Either b m) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap Either a m -> Either m a forall a b. Either a b -> Either b a swapEither Either m b -> Either b m forall a b. Either a b -> Either b a swapEither (p (Either m a) (Either m b) -> p (Either a m) (Either b m)) -> (p a b -> p (Either m a) (Either m b)) -> p a b -> p (Either a m) (Either b m) forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p (Either m a) (Either m b) forall (p :: * -> * -> *) a b m. MChoice p => p a b -> p (Either m a) (Either m b) mright' mright' :: p a b -> p (Either m a) (Either m b) mright' = (Either m a -> Either a m) -> (Either b m -> Either m b) -> p (Either a m) (Either b m) -> p (Either m a) (Either m b) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap Either m a -> Either a m forall a b. Either a b -> Either b a swapEither Either b m -> Either m b forall a b. Either a b -> Either b a swapEither (p (Either a m) (Either b m) -> p (Either m a) (Either m b)) -> (p a b -> p (Either a m) (Either b m)) -> p a b -> p (Either m a) (Either m b) forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p (Either a m) (Either b m) forall (p :: * -> * -> *) a b m. MChoice p => p a b -> p (Either a m) (Either b m) mleft' instance MChoice (->) where mright' :: (a -> b) -> Either m a -> Either m b mright' = (a -> b) -> Either m a -> Either m b forall (p :: * -> * -> *) a b c. Choice p => p a b -> p (Either c a) (Either c b) right' instance Applicative f => MChoice (Star f) where mright' :: Star f a b -> Star f (Either m a) (Either m b) mright' = Star f a b -> Star f (Either m a) (Either m b) forall (p :: * -> * -> *) a b c. Choice p => p a b -> p (Either c a) (Either c b) right' instance (Monoid r) => MChoice (Forget r) where mright' :: Forget r a b -> Forget r (Either m a) (Either m b) mright' = Forget r a b -> Forget r (Either m a) (Either m b) forall (p :: * -> * -> *) a b c. Choice p => p a b -> p (Either c a) (Either c b) right' instance Traversable f => MChoice (Costar f) where mright' :: forall a b m. Costar f a b -> Costar f (Either m a) (Either m b) mright' :: Costar f a b -> Costar f (Either m a) (Either m b) mright' (Costar f :: f a -> b f) = ((f (Either m a) -> Either m b) -> Costar f (Either m a) (Either m b) forall (f :: * -> *) d c. (f d -> c) -> Costar f d c Costar ((f a -> b) -> Either m (f a) -> Either m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap f a -> b f (Either m (f a) -> Either m b) -> (f (Either m a) -> Either m (f a)) -> f (Either m a) -> Either m b forall b c a. (b -> c) -> (a -> b) -> a -> c . f (Either m a) -> Either m (f a) forall (t :: * -> *) (f :: * -> *) a. (Traversable t, Applicative f) => t (f a) -> f (t a) sequenceA)) coprism :: (b -> t) -> (s -> Either t a) -> Coalgebraic s t a b coprism :: (b -> t) -> (s -> Either t a) -> Coalgebraic s t a b coprism rev :: b -> t rev split :: s -> Either t a split = (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 split ((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 rev) (p (Either t a) (Either t b) -> p s t) -> (p a b -> p (Either t a) (Either t b)) -> p a b -> p s t forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p (Either t a) (Either t b) forall (p :: * -> * -> *) a b m. MChoice p => p a b -> p (Either m a) (Either m b) mright' coalgPrism :: Prism s t a b -> Coalgebraic s t a b coalgPrism :: Prism s t a b -> Coalgebraic s t a b coalgPrism pr :: Prism s t a b pr = (b -> t) -> (s -> Either t a) -> Coalgebraic s t a b forall b t s a. (b -> t) -> (s -> Either t a) -> Coalgebraic s t a b coprism ((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 Prism s t a b pr) (Prism s t a b -> s -> Either t a forall s t a b. Prism s t a b -> s -> Either t a matching Prism s t a b pr) _Just' :: Coalgebraic (Maybe a) (Maybe b) a b _Just' :: Optic p (Maybe a) (Maybe b) a b _Just' = Prism (Maybe a) (Maybe b) a b -> Coalgebraic (Maybe a) (Maybe b) a b forall s t a b. Prism s t a b -> Coalgebraic s t a b coalgPrism forall a b. Prism (Maybe a) (Maybe b) a b Prism (Maybe a) (Maybe b) a b _Just _Right' :: Coalgebraic (Either e a) (Either e b) a b _Right' :: Optic p (Either e a) (Either e b) a b _Right' = Prism (Either e a) (Either e b) a b -> Coalgebraic (Either e a) (Either e b) a b forall s t a b. Prism s t a b -> Coalgebraic s t a b coalgPrism forall a b b'. Prism (Either a b) (Either a b') b b' Prism (Either e a) (Either e b) a b _Right