module Pandora.Paradigm.Primary.Functor.Wye where import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Category ((#)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), Covariant_ ((-<$>-))) import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Applicative ((<*>)) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce)) data Wye a = End | Left a | Right a | Both a a instance Covariant Wye where a -> b _ <$> :: (a -> b) -> Wye a -> Wye b <$> Wye a End = Wye b forall a. Wye a End a -> b f <$> Left a x = b -> Wye b forall a. a -> Wye a Left (b -> Wye b) -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a x a -> b f <$> Right a y = b -> Wye b forall a. a -> Wye a Right (b -> Wye b) -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a y a -> b f <$> Both a x a y = b -> b -> Wye b forall a. a -> a -> Wye a Both (b -> b -> Wye b) -> b -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a x (b -> Wye b) -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a y instance Covariant_ Wye (->) (->) where a -> b _ -<$>- :: (a -> b) -> Wye a -> Wye b -<$>- Wye a End = Wye b forall a. Wye a End a -> b f -<$>- Left a x = b -> Wye b forall a. a -> Wye a Left (b -> Wye b) -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a x a -> b f -<$>- Right a y = b -> Wye b forall a. a -> Wye a Right (b -> Wye b) -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a y a -> b f -<$>- Both a x a y = b -> b -> Wye b forall a. a -> a -> Wye a Both (b -> b -> Wye b) -> b -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a x (b -> Wye b) -> b -> Wye b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a -> b f a y instance Traversable Wye where Wye a End ->> :: Wye a -> (a -> u b) -> (u :. Wye) := b ->> a -> u b _ = Wye b -> (u :. Wye) := b forall (t :: * -> *) (source :: * -> * -> *) a. Pointable t source => source a (t a) point Wye b forall a. Wye a End Left a x ->> a -> u b f = b -> Wye b forall a. a -> Wye a Left (b -> Wye b) -> u b -> (u :. Wye) := b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> a -> u b f a x Right a y ->> a -> u b f = b -> Wye b forall a. a -> Wye a Right (b -> Wye b) -> u b -> (u :. Wye) := b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> a -> u b f a y Both a x a y ->> a -> u b f = b -> b -> Wye b forall a. a -> a -> Wye a Both (b -> b -> Wye b) -> u b -> u (b -> Wye b) forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> a -> u b f a x u (b -> Wye b) -> u b -> (u :. Wye) := b forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b <*> a -> u b f a y instance Monotonic a (Wye a) where reduce :: (a -> r -> r) -> r -> Wye a -> r reduce a -> r -> r f r r (Left a x) = a -> r -> r f a x r r reduce a -> r -> r f r r (Right a x) = a -> r -> r f a x r r reduce a -> r -> r f r r (Both a x a y) = a -> r -> r f a y (a -> r -> r f a x r r) reduce a -> r -> r _ r r Wye a End = r r instance Semigroup a => Semigroup (Wye a) where Wye a End + :: Wye a -> Wye a -> Wye a + Wye a x = Wye a x Wye a x + Wye a End = Wye a x Left a x + Left a x' = a -> Wye a forall a. a -> Wye a Left (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a x a -> a -> a forall a. Semigroup a => a -> a -> a + a x' Left a x + Right a y = a -> a -> Wye a forall a. a -> a -> Wye a Both a x a y Left a x + Both a x' a y = a -> a -> Wye a forall a. a -> a -> Wye a Both (a -> a -> Wye a) -> a -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a x a -> a -> a forall a. Semigroup a => a -> a -> a + a x' (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a y Right a y + Left a x = a -> a -> Wye a forall a. a -> a -> Wye a Both a x a y Right a y + Right a y' = a -> Wye a forall a. a -> Wye a Right (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a y a -> a -> a forall a. Semigroup a => a -> a -> a + a y' Right a y + Both a x a y' = a -> a -> Wye a forall a. a -> a -> Wye a Both a x (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a y a -> a -> a forall a. Semigroup a => a -> a -> a + a y' Both a x a y + Left a x' = a -> a -> Wye a forall a. a -> a -> Wye a Both (a -> a -> Wye a) -> a -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a x a -> a -> a forall a. Semigroup a => a -> a -> a + a x' (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a y Both a x a y + Right a y' = a -> a -> Wye a forall a. a -> a -> Wye a Both (a -> a -> Wye a) -> a -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a x (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a y a -> a -> a forall a. Semigroup a => a -> a -> a + a y' Both a x a y + Both a x' a y' = a -> a -> Wye a forall a. a -> a -> Wye a Both (a -> a -> Wye a) -> a -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a x a -> a -> a forall a. Semigroup a => a -> a -> a + a x' (a -> Wye a) -> a -> Wye a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # a y a -> a -> a forall a. Semigroup a => a -> a -> a + a y' instance Semigroup a => Monoid (Wye a) where zero :: Wye a zero = Wye a forall a. Wye a End wye :: r -> (a -> r) -> (a -> r) -> (a -> a -> r) -> Wye a -> r wye :: r -> (a -> r) -> (a -> r) -> (a -> a -> r) -> Wye a -> r wye r r a -> r _ a -> r _ a -> a -> r _ Wye a End = r r wye r _ a -> r f a -> r _ a -> a -> r _ (Left a x) = a -> r f a x wye r _ a -> r _ a -> r g a -> a -> r _ (Right a y) = a -> r g a y wye r _ a -> r _ a -> r _ a -> a -> r h (Both a x a y) = a -> a -> r h a x a y swop :: Wye ~> Wye swop :: Wye a -> Wye a swop Wye a End = Wye a forall a. Wye a End swop (Both a l a r) = a -> a -> Wye a forall a. a -> a -> Wye a Both a r a l swop (Left a l) = a -> Wye a forall a. a -> Wye a Right a l swop (Right a r) = a -> Wye a forall a. a -> Wye a Left a r