-- | Definition copied from TypeCompose-0.9.14: https://hackage.haskell.org/package/TypeCompose-0.9.14
module GLL.Types.TypeCompose where

import Prelude hiding ((.),id)

import Control.Arrow (Arrow(..))
import Control.Category (Category(..))
import Control.Applicative (liftA, liftA2)

-- | Composition of type constructors: unary with binary.  Called
-- "StaticArrow" in [1].
newtype OO f j a b = OO { forall (f :: * -> *) (j :: * -> * -> *) a b.
OO f j a b -> f (j a b)
unOO :: f (a `j` b) }

instance (Applicative f, Category cat) => Category (OO f cat) where
  id :: forall a. OO f cat a a
id          = forall (f :: * -> *) (j :: * -> * -> *) a b.
f (j a b) -> OO f j a b
OO (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  OO f (cat b c)
g . :: forall b c a. OO f cat b c -> OO f cat a b -> OO f cat a c
. OO f (cat a b)
h = forall (f :: * -> *) (j :: * -> * -> *) a b.
f (j a b) -> OO f j a b
OO (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) f (cat b c)
g f (cat a b)
h)

instance (Applicative f, Arrow arr) => Arrow (OO f arr) where
  arr :: forall b c. (b -> c) -> OO f arr b c
arr           = forall (f :: * -> *) (j :: * -> * -> *) a b.
f (j a b) -> OO f j a b
OO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr
  first :: forall b c d. OO f arr b c -> OO f arr (b, d) (c, d)
first (OO f (arr b c)
g)  = forall (f :: * -> *) (j :: * -> * -> *) a b.
f (j a b) -> OO f j a b
OO (forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first f (arr b c)
g)