module Pandora.Pattern.Morphism.Flip where import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (identity)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<))) import Pandora.Core.Appliable (Appliable ((!))) newtype Flip (v :: * -> * -> *) a e = Flip (v e a) instance Semigroupoid m => Semigroupoid (Flip m) where Flip m c b g . :: Flip m b c -> Flip m a b -> Flip m a c . Flip m b a f = m c a -> Flip m a c forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (m b a f m b a -> m c b -> m c a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . m c b g) instance Category m => Category (Flip m) where identity :: Flip m a a identity = m a a -> Flip m a a forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip m a a forall (m :: * -> * -> *) a. Category m => m a a identity instance (Category m, Covariant m m t) => Contravariant (Flip m) m t where >$< :: Flip m a b -> m (t b) (t a) (>$<) (Flip m b a f) = m b a -> m (t b) (t a) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) (<$>) m b a f instance (Category m, Covariant m m t) => Contravariant m (Flip m) t where >$< :: m a b -> Flip m (t b) (t a) (>$<) m a b f = m (t a) (t b) -> Flip m (t b) (t a) forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (m a b -> m (t a) (t b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) (<$>) m a b f) instance (Category m, Covariant m m t) => Covariant (Flip m) (Flip m) t where <$> :: Flip m a b -> Flip m (t a) (t b) (<$>) (Flip m b a f) = m (t b) (t a) -> Flip m (t a) (t b) forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (m b a -> m (t b) (t a) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) (<$>) m b a f) instance Appliable (Flip m) b c m c b where (!) (Flip m c b m) = m c b m