module Pandora.Pattern.Morphism.Straight where

import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))
import Pandora.Pattern.Category (Category (identity))
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))

newtype Straight (v :: * -> * -> *) a e = Straight (v a e)

instance Semigroupoid m => Semigroupoid (Straight m) where
  Straight m b c
g . :: Straight m b c -> Straight m a b -> Straight m a c
. Straight m a b
f = m a c -> Straight m a c
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (m b c
g m b c -> m a b -> m a c
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. m a b
f)

instance Category m => Category (Straight m) where
	identity :: Straight m a a
identity = m a a -> Straight m a a
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight m a a
forall (m :: * -> * -> *) a. Category m => m a a
identity

instance Covariant m m t => Covariant (Straight m) m t where
	<-|- :: Straight m a b -> m (t a) (t b)
(<-|-) (Straight m a b
f) = 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 Covariant m m t => Covariant m (Straight m) t where
	<-|- :: m a b -> Straight m (t a) (t b)
(<-|-) m a b
f = m (t a) (t b) -> Straight m (t a) (t b)
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (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 Covariant m m t => Covariant (Straight m) (Straight m) t where
	<-|- :: Straight m a b -> Straight m (t a) (t b)
(<-|-) (Straight m a b
f) = m (t a) (t b) -> Straight m (t a) (t b)
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (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)