{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE NoStarIsType #-}

{-# OPTIONS_GHC -Wall #-}

-- {-# OPTIONS_GHC -fno-warn-unused-imports #-}  -- TEMP
{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} -- for Oks

-- For ConCat.Inline.ClassOp
{-# OPTIONS_GHC -fplugin=ConCat.Inline.Plugin #-}

-- {-# OPTIONS_GHC -ddump-simpl #-}

-- | Another go at constrained categories. This time without Prod, Coprod, Exp.

module ConCat.Category where

import Prelude hiding (id,(.),curry,uncurry,const,zip,unzip,zipWith,minimum,maximum)
import qualified Prelude as P
import Control.Arrow (Kleisli(..),arr)
import qualified Control.Arrow as A
import Control.Monad ((<=<))
import Data.Typeable (Typeable)
import GHC.Exts (Coercible,coerce)
import qualified GHC.Exts as X
import Data.Type.Equality ((:~:)(..))
import qualified Data.Type.Equality as Eq
import Data.Type.Coercion (Coercion(..))
import qualified Data.Type.Coercion as Co
import GHC.Types (Type)
import Data.Constraint hiding ((&&&),(***),(:=>))
-- import Debug.Trace
import Data.Monoid
import GHC.Generics (U1(..),Par1(..),(:*:)(..),(:.:)(..))
import GHC.TypeLits
import Control.Monad.Fix (MonadFix)
-- import Data.Proxy (Proxy)

import Data.Pointed
import Data.Key (Zip(..))
import Data.Distributive (Distributive(..))
import Data.Functor.Rep (Representable(..))
import Control.Newtype.Generics (Newtype(..))
import Data.Vector.Sized (Vector)
import Data.Finite.Internal (Finite(..))

import ConCat.Misc hiding ((<~),(~>),type (&&))
import ConCat.Rep hiding (Rep)
import ConCat.MinMax
import qualified ConCat.Rep as R
import ConCat.Additive
import qualified ConCat.Inline.ClassOp as IC

#define PINLINER(nm) {-# INLINE nm #-}
-- #define PINLINER(nm)

-- Prevents some subtle non-termination errors. See 2017-12-27 journal notes.
-- #define OPINLINE INLINE [0]

-- Changed to NOINLINE [0]. See 2017-12-29 journal notes.
#define OPINLINE NOINLINE [0]

{--------------------------------------------------------------------
    Unit and pairing for binary type constructors
--------------------------------------------------------------------}

-- Unit for binary type constructors
data U2 a b = U2 deriving (Int -> U2 a b -> ShowS
[U2 a b] -> ShowS
U2 a b -> String
(Int -> U2 a b -> ShowS)
-> (U2 a b -> String) -> ([U2 a b] -> ShowS) -> Show (U2 a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k) k (b :: k). Int -> U2 a b -> ShowS
forall k (a :: k) k (b :: k). [U2 a b] -> ShowS
forall k (a :: k) k (b :: k). U2 a b -> String
$cshowsPrec :: forall k (a :: k) k (b :: k). Int -> U2 a b -> ShowS
showsPrec :: Int -> U2 a b -> ShowS
$cshow :: forall k (a :: k) k (b :: k). U2 a b -> String
show :: U2 a b -> String
$cshowList :: forall k (a :: k) k (b :: k). [U2 a b] -> ShowS
showList :: [U2 a b] -> ShowS
Show)

infixr 7 :**:
-- | Product for binary type constructors
data (p :**: q) a b = p a b :**: q a b

prod :: p a b :* q a b -> (p :**: q) a b
prod :: forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k)
       (q :: k -> k -> Type).
(p a b :* q a b) -> (:**:) p q a b
prod (p a b
p,q a b
q) = (p a b
p p a b -> q a b -> (:**:) p q a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: q a b
q)

unProd :: (p :**: q) a b -> p a b :* q a b
unProd :: forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd (p a b
p :**: q a b
q) = (p a b
p,q a b
q)

exl2 :: (p :**: q) a b -> p a b
exl2 :: forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b
exl2 = Prod (->) (p a b) (q a b) -> p a b
forall a b. Ok2 (->) a b => Prod (->) a b -> a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl (Prod (->) (p a b) (q a b) -> p a b)
-> ((:**:) p q a b -> Prod (->) (p a b) (q a b))
-> (:**:) p q a b
-> p a b
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (:**:) p q a b -> Prod (->) (p a b) (q a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd

exr2 :: (p :**: q) a b -> q a b
exr2 :: forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> q a b
exr2 = Prod (->) (p a b) (q a b) -> q a b
forall a b. Ok2 (->) a b => Prod (->) a b -> b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr (Prod (->) (p a b) (q a b) -> q a b)
-> ((:**:) p q a b -> Prod (->) (p a b) (q a b))
-> (:**:) p q a b
-> q a b
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (:**:) p q a b -> Prod (->) (p a b) (q a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd

instance HasRep ((k :**: k') a b) where
  type Rep ((k :**: k') a b) = k a b :* k' a b
  abst :: Rep ((:**:) k k' a b) -> (:**:) k k' a b
abst (k a b
f,k' a b
g) = k a b
f k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
g
  repr :: (:**:) k k' a b -> Rep ((:**:) k k' a b)
repr (k a b
f :**: k' a b
g) = (k a b
f,k' a b
g)

{--------------------------------------------------------------------
    Monoid wrapper
--------------------------------------------------------------------}

newtype Monoid2 m a b = Monoid2 m

{--------------------------------------------------------------------
    Constraints
--------------------------------------------------------------------}

class HasCon a where
  type Con a :: Constraint
  toDict :: a -> Dict (Con a)
  unDict :: Con a => a

newtype Sat kon a = Sat (Dict (kon a))

instance HasCon (Sat kon a) where
  type Con (Sat kon a) = kon a
  toDict :: Sat kon a -> Dict (Con (Sat kon a))
toDict (Sat Dict (kon a)
d) = Dict (kon a)
Dict (Con (Sat kon a))
d
  unDict :: Con (Sat kon a) => Sat kon a
unDict = Dict (kon a) -> Sat kon a
forall {k} (kon :: k -> Constraint) (a :: k).
Dict (kon a) -> Sat kon a
Sat Dict (kon a)
forall (a :: Constraint). a => Dict a
Dict

instance HasCon () where
  type Con () = ()
  toDict :: () -> Dict (Con ())
toDict () = Dict (() :: Constraint)
Dict (Con ())
forall (a :: Constraint). a => Dict a
Dict
  unDict :: Con () => ()
unDict = ()

instance (HasCon a, HasCon b) => HasCon (a :* b) where
  type Con (a :* b) = (Con a,Con b)
  toDict :: (a :* b) -> Dict (Con (a :* b))
toDict (a -> Dict (Con a)
forall a. HasCon a => a -> Dict (Con a)
toDict -> Dict (Con a)
Dict, b -> Dict (Con b)
forall a. HasCon a => a -> Dict (Con a)
toDict -> Dict (Con b)
Dict) = Dict (Con a, Con b)
Dict (Con (a :* b))
forall (a :: Constraint). a => Dict a
Dict
  unDict :: Con (a :* b) => a :* b
unDict = (a
forall a. (HasCon a, Con a) => a
unDict,b
forall a. (HasCon a, Con a) => a
unDict)

infixr 1 |-
newtype a |- b = Entail (Con a :- Con b)

instance Newtype (a |- b) where
  type O (a |- b) = Con a :- Con b
  pack :: O (a |- b) -> a |- b
pack O (a |- b)
e = (Con a :- Con b) -> a |- b
forall a b. (Con a :- Con b) -> a |- b
Entail Con a :- Con b
O (a |- b)
e
  unpack :: (a |- b) -> O (a |- b)
unpack (Entail Con a :- Con b
e) = Con a :- Con b
O (a |- b)
e

instance Category (|-) where
  -- type Ok (|-) = HasCon
  id :: forall a. Ok (|-) a => a |- a
id = O (a |- a) -> a |- a
forall n. Newtype n => O n -> n
pack Con a :- Con a
O (a |- a)
forall (a :: Constraint). a :- a
refl
  . :: forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
(.) = (O (b |- c) -> O (a |- b) -> O (a |- c))
-> (b |- c) -> (a |- b) -> a |- c
forall p q r.
(Newtype p, Newtype q, Newtype r) =>
(O p -> O q -> O r) -> p -> q -> r
inNew2 (\ O (b |- c)
g O (a |- b)
f -> (Con a => Dict (Con c)) -> Con a :- Con c
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub ((Con a => Dict (Con c)) -> Con a :- Con c)
-> (Con a => Dict (Con c)) -> Con a :- Con c
forall a b. (a -> b) -> a -> b
$ Dict (Con c)
Con c => Dict (Con c)
forall (a :: Constraint). a => Dict a
Dict (Con c => Dict (Con c)) -> (Con b :- Con c) -> Dict (Con c)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Con b :- Con c
O (b |- c)
g (Con b => Dict (Con c)) -> (Con a :- Con b) -> Dict (Con c)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Con a :- Con b
O (a |- b)
f)

instance OpCon (:*) (Sat HasCon) where
  inOp :: forall a b. (Sat HasCon a && Sat HasCon b) |- Sat HasCon (a :* b)
inOp = (Con (Sat HasCon a && Sat HasCon b) :- Con (Sat HasCon (a :* b)))
-> (Sat HasCon a && Sat HasCon b) |- Sat HasCon (a :* b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((HasCon a, HasCon b) => Dict (HasCon (a :* b)))
-> (HasCon a, HasCon b) :- HasCon (a :* b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (HasCon (a :* b))
(HasCon a, HasCon b) => Dict (HasCon (a :* b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance AssociativePCat (|-) where
  lassocP :: forall a b c.
Ok3 (|-) a b c =>
Prod (|-) a (Prod (|-) b c) |- Prod (|-) (Prod (|-) a b) c
lassocP = O ((a :* (b :* c)) |- ((a :* b) :* c))
-> (a :* (b :* c)) |- ((a :* b) :* c)
forall n. Newtype n => O n -> n
pack (((Con a, (Con b, Con c)) => Dict ((Con a, Con b), Con c))
-> (Con a, (Con b, Con c)) :- ((Con a, Con b), Con c)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict ((Con a, Con b), Con c)
(Con a, (Con b, Con c)) => Dict ((Con a, Con b), Con c)
forall (a :: Constraint). a => Dict a
Dict)
  rassocP :: forall a b c.
Ok3 (|-) a b c =>
Prod (|-) (Prod (|-) a b) c |- Prod (|-) a (Prod (|-) b c)
rassocP = O (((a :* b) :* c) |- (a :* (b :* c)))
-> ((a :* b) :* c) |- (a :* (b :* c))
forall n. Newtype n => O n -> n
pack ((((Con a, Con b), Con c) => Dict (Con a, (Con b, Con c)))
-> ((Con a, Con b), Con c) :- (Con a, (Con b, Con c))
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Con a, (Con b, Con c))
((Con a, Con b), Con c) => Dict (Con a, (Con b, Con c))
forall (a :: Constraint). a => Dict a
Dict)

instance MonoidalPCat (|-) where
  *** :: forall a b c d.
Ok4 (|-) a b c d =>
(a |- c) -> (b |- d) -> Prod (|-) a b |- Prod (|-) c d
(***) = (O (a |- c) -> O (b |- d) -> O ((a :* b) |- (c :* d)))
-> (a |- c) -> (b |- d) -> (a :* b) |- (c :* d)
forall p q r.
(Newtype p, Newtype q, Newtype r) =>
(O p -> O q -> O r) -> p -> q -> r
inNew2 ((O (a |- c) -> O (b |- d) -> O ((a :* b) |- (c :* d)))
 -> (a |- c) -> (b |- d) -> (a :* b) |- (c :* d))
-> (O (a |- c) -> O (b |- d) -> O ((a :* b) |- (c :* d)))
-> (a |- c)
-> (b |- d)
-> (a :* b) |- (c :* d)
forall a b. (a -> b) -> a -> b
$ \ O (a |- c)
f O (b |- d)
g -> ((Con a, Con b) => Dict (Con c, Con d))
-> (Con a, Con b) :- (Con c, Con d)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub (((Con a, Con b) => Dict (Con c, Con d))
 -> (Con a, Con b) :- (Con c, Con d))
-> ((Con a, Con b) => Dict (Con c, Con d))
-> (Con a, Con b) :- (Con c, Con d)
forall a b. (a -> b) -> a -> b
$ Dict (Con c, Con d)
Con c => Dict (Con c, Con d)
forall (a :: Constraint). a => Dict a
Dict (Con c => Dict (Con c, Con d))
-> (Con a :- Con c) -> Dict (Con c, Con d)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Con a :- Con c
O (a |- c)
f (Con d => Dict (Con c, Con d))
-> (Con b :- Con d) -> Dict (Con c, Con d)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Con b :- Con d
O (b |- d)
g

instance BraidedPCat (|-) where
  swapP :: forall a b. Ok2 (|-) a b => Prod (|-) a b |- Prod (|-) b a
swapP = O ((a :* b) |- (b :* a)) -> (a :* b) |- (b :* a)
forall n. Newtype n => O n -> n
pack (((Con a, Con b) => Dict (Con b, Con a))
-> (Con a, Con b) :- (Con b, Con a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Con b, Con a)
(Con a, Con b) => Dict (Con b, Con a)
forall (a :: Constraint). a => Dict a
Dict)

instance ProductCat (|-) where
  -- type Prod (|-) = (:*)
  exl :: forall a b. Ok2 (|-) a b => Prod (->) a b |- a
exl = O ((a :* b) |- a) -> (a :* b) |- a
forall n. Newtype n => O n -> n
pack (((Con a, Con b) => Dict (Con a)) -> (Con a, Con b) :- Con a
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Con a)
(Con a, Con b) => Dict (Con a)
forall (a :: Constraint). a => Dict a
Dict)
  exr :: forall a b. Ok2 (|-) a b => Prod (->) a b |- b
exr = O ((a :* b) |- b) -> (a :* b) |- b
forall n. Newtype n => O n -> n
pack (((Con a, Con b) => Dict (Con b)) -> (Con a, Con b) :- Con b
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Con b)
(Con a, Con b) => Dict (Con b)
forall (a :: Constraint). a => Dict a
Dict)
  dup :: forall a. Ok (|-) a => a |- Prod (|-) a a
dup = O (a |- (a :* a)) -> a |- (a :* a)
forall n. Newtype n => O n -> n
pack ((Con a => Dict (Con a, Con a)) -> Con a :- (Con a, Con a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Con a, Con a)
Con a => Dict (Con a, Con a)
forall (a :: Constraint). a => Dict a
Dict)
  -- (&&&) = inNew2 $ \ f g -> Sub $ Dict \\ f \\ g

infixl 1 <+

-- | Wrapper
(<+) :: Con a => (Con b => r) -> (a |- b) -> r
Con b => r
r <+ :: forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ Entail (Sub Dict (Con b)
Con a => Dict (Con b)
Dict) = r
Con b => r
r
-- f <+ Entail e = f \\ e
{-# INLINE (<+) #-}

infixr 3 &&
-- (&&) = Prod (|-)
type (&&) = (:*)

class OpCon op con where
  inOp :: con a && con b |- con (a `op` b)
  -- default inOp :: (forall a b. (Con (con a), Con (con b)) => Con (con (a `op` b)))
  --              => con a && con b |- con (a `op` b)
  -- inOp = Entail (Sub Dict)

-- TODO: Look for a working type for this default inOp definition

-- class    OpCon op (Dict (kon a)) => OpCon' op kon a
-- instance OpCon op (Dict (kon a)) => OpCon' op kon a

-- class    kon a => Sat kon a
-- instance kon a => Sat kon a

yes1 :: c |- Sat Yes1 a
yes1 :: forall {k} c (a :: k). c |- Sat Yes1 a
yes1 = (Con c :- Con (Sat Yes1 a)) -> c |- Sat Yes1 a
forall a b. (Con a :- Con b) -> a |- b
Entail ((Con c => Dict (Yes1 a)) -> Con c :- Yes1 a
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Yes1 a)
Con c => Dict (Yes1 a)
forall (a :: Constraint). a => Dict a
Dict)  -- Move to AltCat

forkCon :: forall con con' a. Sat (con &+& con') a |- Sat con a :* Sat con' a
forkCon :: forall {k} (con :: k -> Constraint) (con' :: k -> Constraint)
       (a :: k).
Sat (con &+& con') a |- (Sat con a :* Sat con' a)
forkCon = (Con (Sat (con &+& con') a) :- Con (Sat con a :* Sat con' a))
-> Sat (con &+& con') a |- (Sat con a :* Sat con' a)
forall a b. (Con a :- Con b) -> a |- b
Entail (((&+&) con con' a => Dict (con a, con' a))
-> (&+&) con con' a :- (con a, con' a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (con a, con' a)
(&+&) con con' a => Dict (con a, con' a)
forall (a :: Constraint). a => Dict a
Dict)

joinCon :: forall con con' a. Sat con a :* Sat con' a |- Sat (con &+& con') a
joinCon :: forall {k} (con :: k -> Constraint) (con' :: k -> Constraint)
       (a :: k).
(Sat con a :* Sat con' a) |- Sat (con &+& con') a
joinCon = (Con (Sat con a :* Sat con' a) :- Con (Sat (con &+& con') a))
-> (Sat con a :* Sat con' a) |- Sat (con &+& con') a
forall a b. (Con a :- Con b) -> a |- b
Entail (((con a, con' a) => Dict ((&+&) con con' a))
-> (con a, con' a) :- (&+&) con con' a
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict ((&+&) con con' a)
(con a, con' a) => Dict ((&+&) con con' a)
forall (a :: Constraint). a => Dict a
Dict)

inForkCon :: (Sat con1 a :* Sat con2 a |- Sat con1' b :* Sat con2' b)
          -> (Sat (con1 &+& con2) a |- Sat (con1' &+& con2') b)
inForkCon :: forall {k} {k} (con1 :: k -> Constraint) (a :: k)
       (con2 :: k -> Constraint) (con1' :: k -> Constraint) (b :: k)
       (con2' :: k -> Constraint).
((Sat con1 a :* Sat con2 a) |- (Sat con1' b :* Sat con2' b))
-> Sat (con1 &+& con2) a |- Sat (con1' &+& con2') b
inForkCon (Sat con1 a :* Sat con2 a) |- (Sat con1' b :* Sat con2' b)
h = (Sat con1' b :* Sat con2' b) |- Sat (con1' &+& con2') b
forall {k} (con :: k -> Constraint) (con' :: k -> Constraint)
       (a :: k).
(Sat con a :* Sat con' a) |- Sat (con &+& con') a
joinCon ((Sat con1' b :* Sat con2' b) |- Sat (con1' &+& con2') b)
-> (Sat (con1 &+& con2) a |- (Sat con1' b :* Sat con2' b))
-> Sat (con1 &+& con2) a |- Sat (con1' &+& con2') b
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (Sat con1 a :* Sat con2 a) |- (Sat con1' b :* Sat con2' b)
h ((Sat con1 a :* Sat con2 a) |- (Sat con1' b :* Sat con2' b))
-> (Sat (con1 &+& con2) a |- (Sat con1 a :* Sat con2 a))
-> Sat (con1 &+& con2) a |- (Sat con1' b :* Sat con2' b)
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. Sat (con1 &+& con2) a |- (Sat con1 a :* Sat con2 a)
forall {k} (con :: k -> Constraint) (con' :: k -> Constraint)
       (a :: k).
Sat (con &+& con') a |- (Sat con a :* Sat con' a)
forkCon

-- We might want forkCon, joinCon, and inForkCon elsewhere as well.
-- Consider renaming.

type Yes1' = Sat Yes1

type Ok' k = Sat (Ok k)

type OpSat op kon = OpCon op (Sat kon)

inSat :: OpCon op (Sat con) => Sat con a && Sat con b |- Sat con (a `op` b)
inSat :: forall {k} (op :: k -> k -> k) (con :: k -> Constraint) (a :: k)
       (b :: k).
OpCon op (Sat con) =>
(Sat con a && Sat con b) |- Sat con (op a b)
inSat = (Sat con a && Sat con b) |- Sat con (op a b)
forall (a :: k) (b :: k).
(Sat con a && Sat con b) |- Sat con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp

inOpL :: OpCon op con => (con a && con b) && con c |- con ((a `op` b) `op` c)
inOpL :: forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
((con a && con b) && con c) |- con (op (op a b) c)
inOpL = (con (op a b) && con c) |- con (op (op a b) c)
forall (a :: k) (b :: k). (con a && con b) |- con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp ((con (op a b) && con c) |- con (op (op a b) c))
-> (((con a && con b) && con c) |- (con (op a b) && con c))
-> ((con a && con b) && con c) |- con (op (op a b) c)
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((con a && con b) |- con (op a b))
-> ((con a && con b) && con c) |- (con (op a b) && con c)
forall a a' b.
Ok3 (|-) a b a' =>
(a |- a') -> Prod (|-) a b |- Prod (|-) a' b
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first  (con a && con b) |- con (op a b)
forall (a :: k) (b :: k). (con a && con b) |- con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp

inOpR :: OpCon op con => con a && (con b && con c) |- con (a `op` (b `op` c))
inOpR :: forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(con a && (con b && con c)) |- con (op a (op b c))
inOpR = (con a && con (op b c)) |- con (op a (op b c))
forall (a :: k) (b :: k). (con a && con b) |- con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp ((con a && con (op b c)) |- con (op a (op b c)))
-> ((con a && (con b && con c)) |- (con a && con (op b c)))
-> (con a && (con b && con c)) |- con (op a (op b c))
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((con b && con c) |- con (op b c))
-> (con a && (con b && con c)) |- (con a && con (op b c))
forall a b b'.
Ok3 (|-) a b b' =>
(b |- b') -> Prod (|-) a b |- Prod (|-) a b'
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second (con b && con c) |- con (op b c)
forall (a :: k) (b :: k). (con a && con b) |- con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp

inOpL' :: OpCon op con
       => (con a && con b) && con c |- con (a `op` b) && con ((a `op` b) `op` c)
inOpL' :: forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
((con a && con b) && con c)
|- (con (op a b) && con (op (op a b) c))
inOpL' = (con a && con b) |- con (op a b)
forall (a :: k) (b :: k). (con a && con b) |- con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp ((con a && con b) |- con (op a b))
-> (((con a && con b) && con c) |- (con a && con b))
-> ((con a && con b) && con c) |- con (op a b)
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((con a && con b) && con c) |- (con a && con b)
forall a b. Ok2 (|-) a b => Prod (->) a b |- a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl (((con a && con b) && con c) |- con (op a b))
-> (((con a && con b) && con c) |- con (op (op a b) c))
-> ((con a && con b) && con c)
   |- Prod (|-) (con (op a b)) (con (op (op a b) c))
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& ((con a && con b) && con c) |- con (op (op a b) c)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
((con a && con b) && con c) |- con (op (op a b) c)
inOpL
-- inOpL' = second inOp . rassocP . first (dup . inOp)

-- (con a && con b) && con c
-- con (a `op` b) && con c
-- (con (a `op` b) && con (a `op` b)) && con c
-- con (a `op` b) && (con (a `op` b) && con c)
-- con (a `op` b) && con ((a `op` b) `op` c)

inOpR' :: OpCon op con => con a && (con b && con c) |- con (a `op` (b `op` c)) &&  con (b `op` c)
inOpR' :: forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(con a && (con b && con c))
|- (con (op a (op b c)) && con (op b c))
inOpR' = (con a && (con b && con c)) |- con (op a (op b c))
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(con a && (con b && con c)) |- con (op a (op b c))
inOpR ((con a && (con b && con c)) |- con (op a (op b c)))
-> ((con a && (con b && con c)) |- con (op b c))
-> (con a && (con b && con c))
   |- Prod (|-) (con (op a (op b c))) (con (op b c))
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& (con b && con c) |- con (op b c)
forall (a :: k) (b :: k). (con a && con b) |- con (op a b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp ((con b && con c) |- con (op b c))
-> ((con a && (con b && con c)) |- (con b && con c))
-> (con a && (con b && con c)) |- con (op b c)
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (con a && (con b && con c)) |- (con b && con c)
forall a b. Ok2 (|-) a b => Prod (->) a b |- b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr
-- inOpR' = first inOp . lassocP . second (dup . inOp)

-- There were mutual recursions between (a) inOpL' & rassocP, and (b) inOpR' & lassocP

inOpLR :: forall op con a b c. OpCon op con =>
  ((con a && con b) && con c) && (con a && (con b && con c))
  |- con ((a `op` b) `op` c) && con (a `op` (b `op` c))
inOpLR :: forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(((con a && con b) && con c) && (con a && (con b && con c)))
|- (con (op (op a b) c) && con (op a (op b c)))
inOpLR = ((con a && con b) && con c) |- con (op (op a b) c)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
((con a && con b) && con c) |- con (op (op a b) c)
inOpL (((con a && con b) && con c) |- con (op (op a b) c))
-> ((con a && (con b && con c)) |- con (op a (op b c)))
-> Prod
     (|-) ((con a && con b) && con c) (con a && (con b && con c))
   |- Prod (|-) (con (op (op a b) c)) (con (op a (op b c)))
forall a b c d.
Ok4 (|-) a b c d =>
(a |- c) -> (b |- d) -> Prod (|-) a b |- Prod (|-) c d
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** (con a && (con b && con c)) |- con (op a (op b c))
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(con a && (con b && con c)) |- con (op a (op b c))
inOpR

instance OpCon op Yes1' where
  inOp :: forall (a :: k) (b :: k). (Yes1' a && Yes1' b) |- Yes1' (op a b)
inOp = (Con (Yes1' a && Yes1' b) :- Con (Yes1' (op a b)))
-> (Yes1' a && Yes1' b) |- Yes1' (op a b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Yes1 a, Yes1 b) => Dict (Yes1 (op a b)))
-> (Yes1 a, Yes1 b) :- Yes1 (op a b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Yes1 (op a b))
(Yes1 a, Yes1 b) => Dict (Yes1 (op a b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance Typeable op => OpCon op (Sat Typeable) where
  inOp :: forall (a :: k) (b :: k).
(Sat Typeable a && Sat Typeable b) |- Sat Typeable (op a b)
inOp = (Con (Sat Typeable a && Sat Typeable b)
 :- Con (Sat Typeable (op a b)))
-> (Sat Typeable a && Sat Typeable b) |- Sat Typeable (op a b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Typeable a, Typeable b) => Dict (Typeable (op a b)))
-> (Typeable a, Typeable b) :- Typeable (op a b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Typeable (op a b))
(Typeable a, Typeable b) => Dict (Typeable (op a b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance OpCon (:*) (Sat Eq) where
  inOp :: forall a b. (Sat Eq a && Sat Eq b) |- Sat Eq (a :* b)
inOp = (Con (Sat Eq a && Sat Eq b) :- Con (Sat Eq (a :* b)))
-> (Sat Eq a && Sat Eq b) |- Sat Eq (a :* b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Eq a, Eq b) => Dict (Eq (a :* b))) -> (Eq a, Eq b) :- Eq (a :* b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Eq (a :* b))
(Eq a, Eq b) => Dict (Eq (a :* b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance OpCon (:*) (Sat Ord) where
  inOp :: forall a b. (Sat Ord a && Sat Ord b) |- Sat Ord (a :* b)
inOp = (Con (Sat Ord a && Sat Ord b) :- Con (Sat Ord (a :* b)))
-> (Sat Ord a && Sat Ord b) |- Sat Ord (a :* b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Ord a, Ord b) => Dict (Ord (a :* b)))
-> (Ord a, Ord b) :- Ord (a :* b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Ord (a :* b))
(Ord a, Ord b) => Dict (Ord (a :* b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

-- TODO: more OpCon instances for standard type classes

instance OpCon (:*) (Sat Additive) where
  inOp :: forall a b.
(Sat Additive a && Sat Additive b) |- Sat Additive (a :* b)
inOp = (Con (Sat Additive a && Sat Additive b)
 :- Con (Sat Additive (a :* b)))
-> (Sat Additive a && Sat Additive b) |- Sat Additive (a :* b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Additive a, Additive b) => Dict (Additive (a :* b)))
-> (Additive a, Additive b) :- Additive (a :* b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (a :* b))
(Additive a, Additive b) => Dict (Additive (a :* b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance OpCon (:+) (Sat Eq) where
  inOp :: forall a b. (Sat Eq a && Sat Eq b) |- Sat Eq (a :+ b)
inOp = (Con (Sat Eq a && Sat Eq b) :- Con (Sat Eq (a :+ b)))
-> (Sat Eq a && Sat Eq b) |- Sat Eq (a :+ b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Eq a, Eq b) => Dict (Eq (a :+ b))) -> (Eq a, Eq b) :- Eq (a :+ b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Eq (a :+ b))
(Eq a, Eq b) => Dict (Eq (a :+ b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance OpCon (:+) (Sat Ord) where
  inOp :: forall a b. (Sat Ord a && Sat Ord b) |- Sat Ord (a :+ b)
inOp = (Con (Sat Ord a && Sat Ord b) :- Con (Sat Ord (a :+ b)))
-> (Sat Ord a && Sat Ord b) |- Sat Ord (a :+ b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Ord a, Ord b) => Dict (Ord (a :+ b)))
-> (Ord a, Ord b) :- Ord (a :+ b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Ord (a :+ b))
(Ord a, Ord b) => Dict (Ord (a :+ b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

instance OpCon (->) (Sat Additive) where
  inOp :: forall a b.
(Sat Additive a && Sat Additive b) |- Sat Additive (a -> b)
inOp = (Con (Sat Additive a && Sat Additive b)
 :- Con (Sat Additive (a -> b)))
-> (Sat Additive a && Sat Additive b) |- Sat Additive (a -> b)
forall a b. (Con a :- Con b) -> a |- b
Entail (((Additive a, Additive b) => Dict (Additive (a -> b)))
-> (Additive a, Additive b) :- Additive (a -> b)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (a -> b))
(Additive a, Additive b) => Dict (Additive (a -> b))
forall (a :: Constraint). a => Dict a
Dict)
  {-# INLINE inOp #-}

class OkAdd k where okAdd :: Ok' k a |- Sat Additive a

type Ok2 k a b         = C2 (Ok k) a b
type Ok3 k a b c       = C3 (Ok k) a b c
type Ok4 k a b c d     = C4 (Ok k) a b c d
type Ok5 k a b c d e   = C5 (Ok k) a b c d e
type Ok6 k a b c d e f = C6 (Ok k) a b c d e f

type Oks k as = AllC (Ok k) as

-- I like the elegance of Oks, but it leads to complex dictionary expressions.
-- For now, use Okn for the operations introduced by lambda-to-ccc conversion.

class Show2 k where show2 :: a `k` b -> String

{--------------------------------------------------------------------
    Categories
--------------------------------------------------------------------}

class Category k where
  type Ok k :: Type -> Constraint
  type Ok k = Yes1
  id  :: Ok k a => a `k` a
  infixr 9 .
  (.) :: forall b c a. Ok3 k a b c => (b `k` c) -> (a `k` b) -> (a `k` c)

infixl 1 <~
infixr 1 ~>
-- | Add post- and pre-processing
(<~) :: (Category k, Oks k [a,b,a',b'])
     => (b `k` b') -> (a' `k` a) -> ((a `k` b) -> (a' `k` b'))
(k b b'
h <~ :: forall (k :: Type -> Type -> Type) a b a' b'.
(Category k, Oks k '[a, b, a', b']) =>
k b b' -> k a' a -> k a b -> k a' b'
<~ k a' a
f) k a b
g = k b b'
h k b b' -> k a' b -> k a' b'
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a b
g k a b -> k a' a -> k a' b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a' a
f

-- | Add pre- and post-processing
(~>) :: (Category k, Oks k [a,b,a',b'])
     => (a' `k` a) -> (b `k` b') -> ((a `k` b) -> (a' `k` b'))
k a' a
f ~> :: forall (k :: Type -> Type -> Type) a b a' b'.
(Category k, Oks k '[a, b, a', b']) =>
k a' a -> k b b' -> k a b -> k a' b'
~> k b b'
h = k b b'
h k b b' -> k a' a -> k a b -> k a' b'
forall (k :: Type -> Type -> Type) a b a' b'.
(Category k, Oks k '[a, b, a', b']) =>
k b b' -> k a' a -> k a b -> k a' b'
<~ k a' a
f

instance Category (->) where
  id :: forall a. Ok (->) a => a -> a
id  = a -> a
forall a. a -> a
P.id
  . :: forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
(.) = (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(P..)

instance Monad m => Category (Kleisli m) where
  id :: forall a. Ok (Kleisli m) a => Kleisli m a a
id  = O (Kleisli m a a) -> Kleisli m a a
forall n. Newtype n => O n -> n
pack O (Kleisli m a a)
a -> m a
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  . :: forall b c a.
Ok3 (Kleisli m) a b c =>
Kleisli m b c -> Kleisli m a b -> Kleisli m a c
(.) = (O (Kleisli m b c) -> O (Kleisli m a b) -> O (Kleisli m a c))
-> Kleisli m b c -> Kleisli m a b -> Kleisli m a c
forall p q r.
(Newtype p, Newtype q, Newtype r) =>
(O p -> O q -> O r) -> p -> q -> r
inNew2 O (Kleisli m b c) -> O (Kleisli m a b) -> O (Kleisli m a c)
(b -> m c) -> (a -> m b) -> a -> m c
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
(<=<)

instance Category (:~:) where
  id :: forall a. Ok (:~:) a => a :~: a
id  = a :~: a
forall {k} (a :: k). a :~: a
Refl
  . :: forall b c a. Ok3 (:~:) a b c => (b :~: c) -> (a :~: b) -> a :~: c
(.) = ((a :~: b) -> (b :~: c) -> a :~: c)
-> (b :~: c) -> (a :~: b) -> a :~: c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a :~: b) -> (b :~: c) -> a :~: c
forall {k} (a :: k) (b :: k) (c :: k).
(a :~: b) -> (b :~: c) -> a :~: c
Eq.trans

instance Category Coercion where
  id :: forall a. Ok Coercion a => Coercion a a
id  = Coercion a a
forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  . :: forall b c a.
Ok3 Coercion a b c =>
Coercion b c -> Coercion a b -> Coercion a c
(.) = (Coercion a b -> Coercion b c -> Coercion a c)
-> Coercion b c -> Coercion a b -> Coercion a c
forall a b c. (a -> b -> c) -> b -> a -> c
flip Coercion a b -> Coercion b c -> Coercion a c
forall {k} (a :: k) (b :: k) (c :: k).
Coercion a b -> Coercion b c -> Coercion a c
Co.trans

instance Category U2 where
  id :: forall a. Ok U2 a => U2 a a
id = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  U2 b c
U2 . :: forall b c a. Ok3 U2 a b c => U2 b c -> U2 a b -> U2 a c
. U2 a b
U2 = U2 a c
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance Monoid m => Category (Monoid2 m) where
  id :: forall a. Ok (Monoid2 m) a => Monoid2 m a a
id = m -> Monoid2 m a a
forall {k} {k} m (a :: k) (b :: k). m -> Monoid2 m a b
Monoid2 m
forall a. Monoid a => a
mempty
  Monoid2 m
m . :: forall b c a.
Ok3 (Monoid2 m) a b c =>
Monoid2 m b c -> Monoid2 m a b -> Monoid2 m a c
. Monoid2 m
n = m -> Monoid2 m a c
forall {k} {k} m (a :: k) (b :: k). m -> Monoid2 m a b
Monoid2 (m
m m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
n)

instance (Category k, Category k') => Category (k :**: k') where
  type Ok (k :**: k') = Ok k &+& Ok k'
  id :: forall a. Ok (k :**: k') a => (:**:) k k' a a
id = k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall a. Ok k' a => k' a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id
  (k b c
g :**: k' b c
g') . :: forall b c a.
Ok3 (k :**: k') a b c =>
(:**:) k k' b c -> (:**:) k k' a b -> (:**:) k k' a c
. (k a b
f :**: k' a b
f') = k b c
gk b c -> k a b -> k a c
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
.k a b
f k a c -> k' a c -> (:**:) k k' a c
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' b c
g'k' b c -> k' a b -> k' a c
forall b c a. Ok3 k' a b c => k' b c -> k' a b -> k' a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
.k' a b
f'
  PINLINER(id)
  PINLINER((.))

{--------------------------------------------------------------------
    Products
--------------------------------------------------------------------}

type Prod k = (:*)

infixr 3 ***, &&&

type OkProd k = OpCon (Prod k) (Ok' k)

okProd :: forall k a b. OkProd k
       => Ok' k a && Ok' k b |- Ok' k (Prod k a b)
okProd :: forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd = (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a, b)
forall a b. (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :* b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp
{-# INLINE okProd #-}

class (Category k, OkProd k) => AssociativePCat k where
  lassocP :: forall a b c. Ok3 k a b c
          => Prod k a (Prod k b c) `k` Prod k (Prod k a b) c
  default lassocP :: forall a b c. (MProductCat k, Ok3 k a b c)
                  => Prod k a (Prod k b c) `k` Prod k (Prod k a b) c
  lassocP = k (b :* c) b -> k (a :* (b :* c)) (Prod k a b)
forall a b b'.
Ok3 k a b b' =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second k (b :* c) b
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl k (a :* (b :* c)) (Prod k a b)
-> k (a :* (b :* c)) c -> k (a :* (b :* c)) (Prod k (Prod k a b) c)
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& (k (b :* c) c
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr k (b :* c) c -> k (a :* (b :* c)) (b :* c) -> k (a :* (b :* c)) c
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (a :* (b :* c)) (b :* c)
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr)
            (Con (Sat (Ok k) (Prod k a b)) =>
 k (a :* (b :* c)) (Prod k (Prod k a b) c))
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (Prod k a b))
-> k (a :* (b :* c)) (Prod k (Prod k a b) c)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @b
            (Con (Sat (Ok k) (a :* (b :* c)) && Sat (Ok k) (b :* c)) =>
 k (a :* (b :* c)) (Prod k (Prod k a b) c))
-> ((Sat (Ok k) a && (Sat (Ok k) b && Sat (Ok k) c))
    |- (Sat (Ok k) (a :* (b :* c)) && Sat (Ok k) (b :* c)))
-> k (a :* (b :* c)) (Prod k (Prod k a b) c)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(con a && (con b && con c))
|- (con (op a (op b c)) && con (op b c))
forall (op :: Type -> Type -> Type) (con :: Type -> Type) a b c.
OpCon op con =>
(con a && (con b && con c))
|- (con (op a (op b c)) && con (op b c))
inOpR' @(Prod k) @(Ok' k) @a @b @c
  {-# INLINE lassocP #-}
  rassocP :: forall a b c. Ok3 k a b c
          => Prod k (Prod k a b) c `k` Prod k a (Prod k b c)
  default rassocP :: forall a b c. (MProductCat k, Ok3 k a b c)
                  => Prod k (Prod k a b) c `k` Prod k a (Prod k b c)
  rassocP = (k (a :* b) a
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl k (a :* b) a -> k ((a :* b) :* c) (a :* b) -> k ((a :* b) :* c) a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k ((a :* b) :* c) (a :* b)
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl) k ((a :* b) :* c) a
-> k ((a :* b) :* c) (Prod k b c)
-> k ((a :* b) :* c) (Prod k a (Prod k b c))
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k (a :* b) b -> k ((a :* b) :* c) (Prod k b c)
forall a a' b.
Ok3 k a b a' =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first  k (a :* b) b
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr
            (Con (Sat (Ok k) (Prod k b c)) =>
 k ((a :* b) :* c) (Prod k a (Prod k b c)))
-> ((Sat (Ok k) b && Sat (Ok k) c) |- Sat (Ok k) (Prod k b c))
-> k ((a :* b) :* c) (Prod k a (Prod k b c))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k    @b @c
            (Con (Sat (Ok k) (a :* b) && Sat (Ok k) ((a :* b) :* c)) =>
 k ((a :* b) :* c) (Prod k a (Prod k b c)))
-> (((Sat (Ok k) a && Sat (Ok k) b) && Sat (Ok k) c)
    |- (Sat (Ok k) (a :* b) && Sat (Ok k) ((a :* b) :* c)))
-> k ((a :* b) :* c) (Prod k a (Prod k b c))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
((con a && con b) && con c)
|- (con (op a b) && con (op (op a b) c))
forall (op :: Type -> Type -> Type) (con :: Type -> Type) a b c.
OpCon op con =>
((con a && con b) && con c)
|- (con (op a b) && con (op (op a b) c))
inOpL' @(Prod k) @(Ok' k) @a @b @c
  {-# INLINE rassocP #-}

-- | Category with monoidal product.
class (Category k, OkProd k) => MonoidalPCat k where
  (***) :: forall a b c d. Ok4 k a b c d
        => (a `k` c) -> (b `k` d) -> (Prod k a b `k` Prod k c d)
  first :: forall a a' b. Ok3 k a b a'
        => (a `k` a') -> (Prod k a b `k` Prod k a' b)
  first = (k a a' -> k b b -> k (Prod k a b) (Prod k a' b)
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k b b
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id)
  {-# INLINE first #-}
  second :: forall a b b'. Ok3 k a b b'
         => (b `k` b') -> (Prod k a b `k` Prod k a b')
  second = (k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id k a a -> k b b' -> k (Prod k a b) (Prod k a b')
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
***)
  {-# INLINE second #-}

-- | Braided monoidal category
class (Category k, OkProd k {- , MonoidalPCat k -}) => BraidedPCat k where
  swapP :: forall a b. Ok2 k a b => Prod k a b `k` Prod k b a
  default swapP :: forall a b. (ProductCat k, MonoidalPCat k, Ok2 k a b)
                => Prod k a b `k` Prod k b a
  swapP = k (a :* b) b
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr k (a :* b) b -> k (a :* b) a -> k (a :* b) (Prod k b a)
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k (a :* b) a
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl
          (Con (Sat (Ok k) (a :* b)) => k (a :* b) (Prod k b a))
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :* b))
-> k (a :* b) (Prod k b a)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @b
  {-# INLINE swapP #-}

type MBraidedPCat k = (BraidedPCat k, MonoidalPCat k)

-- | Category with product.
class (Category k, OkProd k) => ProductCat k where
  exl :: Ok2 k a b => Prod k a b `k` a
  exr :: Ok2 k a b => Prod k a b `k` b
  dup :: Ok  k a => a `k` Prod k a a

(&&&) :: forall k a c d. (MProductCat k, Ok3 k a c d)
      => (a `k` c) -> (a `k` d) -> (a `k` Prod k c d)
k a c
f &&& :: forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k a d
g = (k a c
f k a c -> k a d -> k (a :* a) (c :* d)
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k a d
g) k (a :* a) (c :* d) -> k a (a :* a) -> k a (c :* d)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a (a :* a)
forall a. Ok k a => k a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
  (Con (Sat (Ok k) (a :* a)) => k a (c :* d))
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :* a))
-> k a (c :* d)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
  (Con (Sat (Ok k) (c :* d)) => k a (c :* d))
-> ((Sat (Ok k) c && Sat (Ok k) d) |- Sat (Ok k) (c :* d))
-> k a (c :* d)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @c @d
{-# INLINE (&&&) #-}

type MProductCat k = (ProductCat k, MonoidalPCat k)

instance AssociativePCat (->) where
  lassocP :: forall a b c.
Ok3 (->) a b c =>
Prod (|-) a (Prod (|-) b c) -> Prod (|-) (Prod (|-) a b) c
lassocP = \ (a
a,(b
b,c
c)) -> ((a
a,b
b),c
c)
  rassocP :: forall a b c.
Ok3 (->) a b c =>
Prod (|-) (Prod (|-) a b) c -> Prod (|-) a (Prod (|-) b c)
rassocP = \ ((a
a,b
b),c
c) -> (a
a,(b
b,c
c))
  
instance MonoidalPCat (->) where
  *** :: forall a b c d.
Ok4 (->) a b c d =>
(a -> c) -> (b -> d) -> Prod (|-) a b -> Prod (|-) c d
(***)  = (a -> c) -> (b -> d) -> (a, b) -> (c, d)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: Type -> Type -> Type) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(A.***)
  first :: forall a a' b.
Ok3 (->) a b a' =>
(a -> a') -> Prod (|-) a b -> Prod (|-) a' b
first  = (a -> a') -> (a, b) -> (a', b)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first
  second :: forall a b b'.
Ok3 (->) a b b' =>
(b -> b') -> Prod (|-) a b -> Prod (|-) a b'
second = (b -> b') -> (a, b) -> (a, b')
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second

instance BraidedPCat (->) where
  swapP :: forall a b. Ok2 (->) a b => Prod (|-) a b -> Prod (|-) b a
swapP = \ (a
a,b
b) -> (b
b,a
a)

instance ProductCat (->) where
  -- type Prod (->) = (:*)
  exl :: forall a b. Ok2 (->) a b => Prod (->) a b -> a
exl = (a, b) -> a
forall a b. (a, b) -> a
fst
  exr :: forall a b. Ok2 (->) a b => Prod (->) a b -> b
exr = (a, b) -> b
forall a b. (a, b) -> b
snd
  dup :: forall a. Ok (->) a => a -> Prod (|-) a a
dup = \ a
a -> (a
a,a
a)

-- TODO: do we want inline for (&&&), (***), first, and second?

instance MonoidalPCat U2 where
  U2 a c
U2 *** :: forall a b c d.
Ok4 U2 a b c d =>
U2 a c -> U2 b d -> U2 (Prod (|-) a b) (Prod (|-) c d)
*** U2 b d
U2 = U2 (Prod U2 a b) (Prod U2 c d)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  PINLINER((***))

instance BraidedPCat U2 where
  swapP :: forall a b. Ok2 U2 a b => U2 (Prod (|-) a b) (Prod (|-) b a)
swapP = U2 (Prod U2 a b) (Prod U2 b a)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  PINLINER(swapP)

instance ProductCat U2 where
  exl :: forall a b. Ok2 U2 a b => U2 (Prod (->) a b) a
exl = U2 (Prod U2 a b) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  exr :: forall a b. Ok2 U2 a b => U2 (Prod (->) a b) b
exr = U2 (Prod U2 a b) b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  dup :: forall a. Ok U2 a => U2 a (Prod (|-) a a)
dup = U2 a (Prod U2 a a)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  -- U2 &&& U2 = U2
  PINLINER(exl)
  PINLINER(exr)
  PINLINER(dup)
  -- PINLINER((&&&))

instance (AssociativePCat k, AssociativePCat k') => AssociativePCat (k :**: k') where
  lassocP :: forall a b c.
Ok3 (k :**: k') a b c =>
(:**:)
  k k' (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
lassocP = k (Prod k a (Prod k b c)) (Prod k (Prod k a b) c)
forall a b c.
Ok3 k a b c =>
k (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
forall (k :: Type -> Type -> Type) a b c.
(AssociativePCat k, Ok3 k a b c) =>
k (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
lassocP k (Prod k a (Prod k b c)) (Prod k (Prod k a b) c)
-> k' (Prod k a (Prod k b c)) (Prod k (Prod k a b) c)
-> (:**:) k k' (Prod k a (Prod k b c)) (Prod k (Prod k a b) c)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k a (Prod k b c)) (Prod k (Prod k a b) c)
forall a b c.
Ok3 k' a b c =>
k' (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
forall (k :: Type -> Type -> Type) a b c.
(AssociativePCat k, Ok3 k a b c) =>
k (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
lassocP
  rassocP :: forall a b c.
Ok3 (k :**: k') a b c =>
(:**:)
  k k' (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
rassocP = k (Prod k (Prod k a b) c) (Prod k a (Prod k b c))
forall a b c.
Ok3 k a b c =>
k (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
forall (k :: Type -> Type -> Type) a b c.
(AssociativePCat k, Ok3 k a b c) =>
k (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
rassocP k (Prod k (Prod k a b) c) (Prod k a (Prod k b c))
-> k' (Prod k (Prod k a b) c) (Prod k a (Prod k b c))
-> (:**:) k k' (Prod k (Prod k a b) c) (Prod k a (Prod k b c))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k (Prod k a b) c) (Prod k a (Prod k b c))
forall a b c.
Ok3 k' a b c =>
k' (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
forall (k :: Type -> Type -> Type) a b c.
(AssociativePCat k, Ok3 k a b c) =>
k (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
rassocP
  PINLINER(lassocP)
  PINLINER(rassocP)

instance (MonoidalPCat k, MonoidalPCat k') => MonoidalPCat (k :**: k') where
  (k a c
f :**: k' a c
f') *** :: forall a b c d.
Ok4 (k :**: k') a b c d =>
(:**:) k k' a c
-> (:**:) k k' b d -> (:**:) k k' (Prod (|-) a b) (Prod (|-) c d)
*** (k b d
g :**: k' b d
g') = (k a c
f k a c -> k b d -> k (Prod k a b) (Prod k c d)
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k b d
g) k (Prod k a b) (Prod k c d)
-> k' (Prod k a b) (Prod k c d)
-> (:**:) k k' (Prod k a b) (Prod k c d)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: (k' a c
f' k' a c -> k' b d -> k' (Prod k a b) (Prod k c d)
forall a b c d.
Ok4 k' a b c d =>
k' a c -> k' b d -> k' (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k' b d
g')
  first :: forall a a' b.
Ok3 (k :**: k') a b a' =>
(:**:) k k' a a' -> (:**:) k k' (Prod (|-) a b) (Prod (|-) a' b)
first (k a a'
f :**: k' a a'
f') = k a a' -> k (Prod k a b) (Prod k a' b)
forall a a' b.
Ok3 k a b a' =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first k a a'
f k (Prod k a b) (Prod k a' b)
-> k' (Prod k a b) (Prod k a' b)
-> (:**:) k k' (Prod k a b) (Prod k a' b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a' -> k' (Prod k a b) (Prod k a' b)
forall a a' b.
Ok3 k' a b a' =>
k' a a' -> k' (Prod (|-) a b) (Prod (|-) a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first k' a a'
f'
  second :: forall a b b'.
Ok3 (k :**: k') a b b' =>
(:**:) k k' b b' -> (:**:) k k' (Prod (|-) a b) (Prod (|-) a b')
second (k b b'
f :**: k' b b'
f') = k b b' -> k (Prod k a b) (Prod k a b')
forall a b b'.
Ok3 k a b b' =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second k b b'
f k (Prod k a b) (Prod k a b')
-> k' (Prod k a b) (Prod k a b')
-> (:**:) k k' (Prod k a b) (Prod k a b')
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' b b' -> k' (Prod k a b) (Prod k a b')
forall a b b'.
Ok3 k' a b b' =>
k' b b' -> k' (Prod (|-) a b) (Prod (|-) a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second k' b b'
f'
  PINLINER((***))
  PINLINER(first)
  PINLINER(second)

instance (BraidedPCat k, BraidedPCat k') => BraidedPCat (k :**: k') where
  swapP :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' (Prod (|-) a b) (Prod (|-) b a)
swapP = k (Prod k a b) (Prod k b a)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP k (Prod k a b) (Prod k b a)
-> k' (Prod k a b) (Prod k b a)
-> (:**:) k k' (Prod k a b) (Prod k b a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k a b) (Prod k b a)
forall a b. Ok2 k' a b => k' (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP
  PINLINER(swapP)

instance (ProductCat k, ProductCat k') => ProductCat (k :**: k') where
  exl :: forall a b. Ok2 (k :**: k') a b => (:**:) k k' (Prod (->) a b) a
exl = k (Prod k a b) a
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl k (Prod k a b) a -> k' (Prod k a b) a -> (:**:) k k' (Prod k a b) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k a b) a
forall a b. Ok2 k' a b => k' (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl
  exr :: forall a b. Ok2 (k :**: k') a b => (:**:) k k' (Prod (->) a b) b
exr = k (Prod k a b) b
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr k (Prod k a b) b -> k' (Prod k a b) b -> (:**:) k k' (Prod k a b) b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k a b) b
forall a b. Ok2 k' a b => k' (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr
  dup :: forall a. Ok (k :**: k') a => (:**:) k k' a (Prod (|-) a a)
dup = k a (Prod k a a)
forall a. Ok k a => k a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup k a (Prod k a a) -> k' a (Prod k a a) -> (:**:) k k' a (Prod k a a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (Prod k a a)
forall a. Ok k' a => k' a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
  PINLINER(exl)
  PINLINER(exr)
  PINLINER(dup)

instance Monad m => MonoidalPCat (Kleisli m) where
  *** :: forall a b c d.
Ok4 (Kleisli m) a b c d =>
Kleisli m a c
-> Kleisli m b d -> Kleisli m (Prod (|-) a b) (Prod (|-) c d)
(***) = Kleisli m a c -> Kleisli m b d -> Kleisli m (a, b) (c, d)
forall b c b' c'.
Kleisli m b c -> Kleisli m b' c' -> Kleisli m (b, b') (c, c')
forall (a :: Type -> Type -> Type) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(A.***)
  PINLINER((***))

instance Monad m => BraidedPCat (Kleisli m) where
  swapP :: forall a b.
Ok2 (Kleisli m) a b =>
Kleisli m (Prod (|-) a b) (Prod (|-) b a)
swapP = (Prod (Kleisli m) a b -> Prod (Kleisli m) b a)
-> Kleisli m (Prod (Kleisli m) a b) (Prod (Kleisli m) b a)
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a b -> Prod (Kleisli m) b a
forall a b. Ok2 (->) a b => Prod (|-) a b -> Prod (|-) b a
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP

instance Monad m => ProductCat (Kleisli m) where
  -- type Prod (Kleisli m) = (:*)
  exl :: forall a b. Ok2 (Kleisli m) a b => Kleisli m (Prod (->) a b) a
exl   = (Prod (Kleisli m) a b -> a) -> Kleisli m (Prod (Kleisli m) a b) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a b -> a
forall a b. Ok2 (->) a b => Prod (->) a b -> a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl
  exr :: forall a b. Ok2 (Kleisli m) a b => Kleisli m (Prod (->) a b) b
exr   = (Prod (Kleisli m) a b -> b) -> Kleisli m (Prod (Kleisli m) a b) b
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a b -> b
forall a b. Ok2 (->) a b => Prod (->) a b -> b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr
  dup :: forall a. Ok (Kleisli m) a => Kleisli m a (Prod (|-) a a)
dup   = (a -> Prod (Kleisli m) a a) -> Kleisli m a (Prod (Kleisli m) a a)
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> Prod (Kleisli m) a a
forall a. Ok (->) a => a -> Prod (|-) a a
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
  PINLINER(exl)
  PINLINER(exr)
  PINLINER(dup)

{--------------------------------------------------------------------
    Coproducts
--------------------------------------------------------------------}

type Coprod k = (:+)

type OkCoprod k = OpCon (Coprod k) (Ok' k)

okCoprod :: forall k a b. OkCoprod k
         => Ok' k a && Ok' k b |- Ok' k (Coprod k a b)
okCoprod :: forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod = (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (Either a b)
forall a b. (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :+ b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp
{-# INLINE okCoprod #-}

infixr 2 +++, |||

class (Category k, OkCoprod k) => AssociativeSCat k where
  lassocS :: forall a b c. Oks k [a,b,c]
          => Coprod k a (Coprod k b c) `k` Coprod k (Coprod k a b) c
  default lassocS :: forall a b c. (MCoproductCat k, Oks k [a,b,c])
                  => Coprod k a (Coprod k b c) `k` Coprod k (Coprod k a b) c
  lassocS = k (Coprod k a b) (Coprod k (Coprod k a b) c)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inlk (Coprod k a b) (Coprod k (Coprod k a b) c)
-> k a (Coprod k a b) -> k a (Coprod k (Coprod k a b) c)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
.k a (Coprod k a b)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl k a (Coprod k (Coprod k a b) c)
-> k (b :+ c) (Coprod k (Coprod k a b) c)
-> k (Coprod k a (b :+ c)) (Coprod k (Coprod k a b) c)
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| (k (Coprod k a b) (Coprod k (Coprod k a b) c)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inlk (Coprod k a b) (Coprod k (Coprod k a b) c)
-> k b (Coprod k a b) -> k b (Coprod k (Coprod k a b) c)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
.k b (Coprod k a b)
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr k b (Coprod k (Coprod k a b) c)
-> k c (Coprod k (Coprod k a b) c)
-> k (b :+ c) (Coprod k (Coprod k a b) c)
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| k c (Coprod k (Coprod k a b) c)
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr)
            (Con
   (Sat (Ok k) (Coprod k a b)
    && Sat (Ok k) (Coprod k (Coprod k a b) c)) =>
 k (Coprod k a (b :+ c)) (Coprod k (Coprod k a b) c))
-> (((Sat (Ok k) a && Sat (Ok k) b) && Sat (Ok k) c)
    |- (Sat (Ok k) (Coprod k a b)
        && Sat (Ok k) (Coprod k (Coprod k a b) c)))
-> k (Coprod k a (b :+ c)) (Coprod k (Coprod k a b) c)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
((con a && con b) && con c)
|- (con (op a b) && con (op (op a b) c))
forall (op :: Type -> Type -> Type) (con :: Type -> Type) a b c.
OpCon op con =>
((con a && con b) && con c)
|- (con (op a b) && con (op (op a b) c))
inOpL' @(Coprod k) @(Ok' k) @a @b @c
            (Con (Sat (Ok k) (b :+ c)) =>
 k (Coprod k a (b :+ c)) (Coprod k (Coprod k a b) c))
-> ((Sat (Ok k) b && Sat (Ok k) c) |- Sat (Ok k) (b :+ c))
-> k (Coprod k a (b :+ c)) (Coprod k (Coprod k a b) c)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k    @b @c
  {-# INLINE lassocS #-}
  rassocS :: forall a b c. Oks k [a,b,c]
          => Coprod k (Coprod k a b) c `k` Coprod k a (Coprod k b c)
  default rassocS :: forall a b c. (MCoproductCat k, Oks k [a,b,c])
                  => Coprod k (Coprod k a b) c `k` Coprod k a (Coprod k b c)
  rassocS = (k a (Coprod k a (Coprod k b c))
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl k a (Coprod k a (Coprod k b c))
-> k b (Coprod k a (Coprod k b c))
-> k (a :+ b) (Coprod k a (Coprod k b c))
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| k (Coprod k b c) (Coprod k a (Coprod k b c))
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inrk (Coprod k b c) (Coprod k a (Coprod k b c))
-> k b (Coprod k b c) -> k b (Coprod k a (Coprod k b c))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
.k b (Coprod k b c)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl) k (a :+ b) (Coprod k a (Coprod k b c))
-> k c (Coprod k a (Coprod k b c))
-> k (Coprod k (a :+ b) c) (Coprod k a (Coprod k b c))
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| k (Coprod k b c) (Coprod k a (Coprod k b c))
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inrk (Coprod k b c) (Coprod k a (Coprod k b c))
-> k c (Coprod k b c) -> k c (Coprod k a (Coprod k b c))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
.k c (Coprod k b c)
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr
            (Con
   (Sat (Ok k) (Coprod k a (Coprod k b c))
    && Sat (Ok k) (Coprod k b c)) =>
 k (Coprod k (a :+ b) c) (Coprod k a (Coprod k b c)))
-> ((Sat (Ok k) a && (Sat (Ok k) b && Sat (Ok k) c))
    |- (Sat (Ok k) (Coprod k a (Coprod k b c))
        && Sat (Ok k) (Coprod k b c)))
-> k (Coprod k (a :+ b) c) (Coprod k a (Coprod k b c))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k) (b :: k)
       (c :: k).
OpCon op con =>
(con a && (con b && con c))
|- (con (op a (op b c)) && con (op b c))
forall (op :: Type -> Type -> Type) (con :: Type -> Type) a b c.
OpCon op con =>
(con a && (con b && con c))
|- (con (op a (op b c)) && con (op b c))
inOpR' @(Coprod k) @(Ok' k) @a @b @c
            (Con (Sat (Ok k) (a :+ b)) =>
 k (Coprod k (a :+ b) c) (Coprod k a (Coprod k b c)))
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :+ b))
-> k (Coprod k (a :+ b) c) (Coprod k a (Coprod k b c))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @a @b
  {-# INLINE rassocS #-}

class (Category k, OkCoprod k) => BraidedSCat k where
  swapS :: forall a b. Ok2 k a b => Coprod k a b `k` Coprod k b a
  default swapS :: forall a b. (MCoproductCat k, Ok2 k a b) => Coprod k a b `k` Coprod k b a
  swapS = k a (b :+ a)
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr k a (b :+ a) -> k b (b :+ a) -> k (Coprod k a b) (b :+ a)
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| k b (b :+ a)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl (Con (Sat (Ok k) (b :+ a)) => k (Coprod k a b) (b :+ a))
-> ((Sat (Ok k) b && Sat (Ok k) a) |- Sat (Ok k) (b :+ a))
-> k (Coprod k a b) (b :+ a)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @b @a
  {-# INLINE swapS #-}

-- Monoidal category over sums
class (OkCoprod k, Category k) => MonoidalSCat k where
  (+++) :: forall a b c d. Ok4 k a b c d
        => (c `k` a) -> (d `k` b) -> (Coprod k c d `k` Coprod k a b)
  left  :: forall a a' b. Oks k [a,b,a']
        => (a `k` a') -> (Coprod k a b `k` Coprod k a' b)
  left  = (k a a' -> k b b -> k (Coprod k a b) (Coprod k a' b)
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k b b
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id)
  {-# INLINE left #-}
  right :: forall a b b'. Oks k [a,b,b']
        => (b `k` b') -> (Coprod k a b `k` Coprod k a b')
  right = (k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id k a a -> k b b' -> k (Coprod k a b) (Coprod k a b')
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++)
  {-# INLINE right #-}

-- | Category with coproduct.
class (Category k, OkCoprod k) => CoproductCat k where
  -- type Coprod k :: u -> u -> u
  -- type Coprod k = (:+)
  inl :: Ok2 k a b => a `k` Coprod k a b
  inr :: Ok2 k a b => b `k` Coprod k a b
  jam :: Ok k a => Coprod k a a `k` a

type MCoproductCat k = (CoproductCat k, MonoidalSCat k)

(|||) :: forall k a c d. (MCoproductCat k, Ok3 k a c d)
      => (c `k` a) -> (d `k` a) -> (Coprod k c d `k` a)
k c a
f ||| :: forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| k d a
g = k (a :+ a) a
forall a. Ok k a => k (Coprod k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductCat k, Ok k a) =>
k (Coprod k a a) a
jam k (a :+ a) a -> k (c :+ d) (a :+ a) -> k (c :+ d) a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (k c a
f k c a -> k d a -> k (c :+ d) (a :+ a)
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k d a
g)
        (Con (Sat (Ok k) (a :+ a)) => k (c :+ d) a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :+ a))
-> k (c :+ d) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @a @a
        (Con (Sat (Ok k) (c :+ d)) => k (c :+ d) a)
-> ((Sat (Ok k) c && Sat (Ok k) d) |- Sat (Ok k) (c :+ d))
-> k (c :+ d) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @c @d
{-# INLINE (|||) #-}

instance AssociativeSCat (->)

instance MonoidalSCat (->) where
  +++ :: forall a b c d.
Ok4 (->) a b c d =>
(c -> a) -> (d -> b) -> Coprod k c d -> Coprod k a b
(+++) = (c -> a) -> (d -> b) -> Either c d -> Either a b
forall b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: Type -> Type -> Type) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(A.+++)
  left :: forall a a' b.
Oks (->) '[a, b, a'] =>
(a -> a') -> Coprod k a b -> Coprod k a' b
left  = (a -> a') -> Either a b -> Either a' b
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
A.left
  right :: forall a b b'.
Oks (->) '[a, b, b'] =>
(b -> b') -> Coprod k a b -> Coprod k a b'
right = (b -> b') -> Either a b -> Either a b'
forall b c d. (b -> c) -> Either d b -> Either d c
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
A.right

instance BraidedSCat (->) where
  swapS :: forall a b. Ok2 (->) a b => Coprod (->) a b -> Coprod (->) b a
swapS = a -> b :+ a
forall a b. b -> Either a b
Right (a -> b :+ a) -> (b -> b :+ a) -> Either a b -> b :+ a
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| b -> b :+ a
forall a b. a -> Either a b
Left

instance CoproductCat (->) where
  -- type Coprod (->) = (:+)
  inl :: forall a b. Ok2 (->) a b => a -> Coprod k a b
inl = a -> Either a b
forall a b. a -> Either a b
Left
  inr :: forall a b. Ok2 (->) a b => b -> Coprod k a b
inr = b -> Either a b
forall a b. b -> Either a b
Right
  jam :: forall a. Ok (->) a => Coprod k a a -> a
jam = a -> a
forall a. Ok (->) a => a -> a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` a -> a
forall a. Ok (->) a => a -> a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id

-- TODO: do we want inline for (|||), (+++), left, and right?

instance Monad m => MonoidalSCat (Kleisli m) where
  +++ :: forall a b c d.
Ok4 (Kleisli m) a b c d =>
Kleisli m c a
-> Kleisli m d b -> Kleisli m (Coprod k c d) (Coprod k a b)
(+++) = (O (Kleisli m c a)
 -> O (Kleisli m d b) -> O (Kleisli m (c :+ d) (a :+ b)))
-> Kleisli m c a -> Kleisli m d b -> Kleisli m (c :+ d) (a :+ b)
forall p q r.
(Newtype p, Newtype q, Newtype r) =>
(O p -> O q -> O r) -> p -> q -> r
inNew2 (\ O (Kleisli m c a)
f O (Kleisli m d b)
g -> ((a -> a :+ b) -> m a -> m (a :+ b)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a :+ b
forall a b. a -> Either a b
Left (m a -> m (a :+ b))
-> (m b -> m (a :+ b)) -> Coprod (->) (m a) (m b) -> m (a :+ b)
forall (k :: Type -> Type -> Type) a c d.
(MCoproductCat k, Ok3 k a c d) =>
k c a -> k d a -> k (Coprod k c d) a
||| (b -> a :+ b) -> m b -> m (a :+ b)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a :+ b
forall a b. b -> Either a b
Right) (Coprod (->) (m a) (m b) -> m (a :+ b))
-> ((c :+ d) -> Coprod (->) (m a) (m b)) -> (c :+ d) -> m (a :+ b)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (O (Kleisli m c a)
c -> m a
f (c -> m a) -> (d -> m b) -> (c :+ d) -> Coprod (->) (m a) (m b)
forall a b c d.
Ok4 (->) a b c d =>
(c -> a) -> (d -> b) -> Coprod k c d -> Coprod k a b
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ O (Kleisli m d b)
d -> m b
g))

-- f :: a -> m c
-- g :: b -> m d
-- f +++ g :: a :+ b -> m c :+ m d
-- fmap Left ||| fmap Right :: m c :+ m d -> m (c :+ d)

instance Monad m => BraidedSCat (Kleisli m) where
  swapS :: forall a b.
Ok2 (Kleisli m) a b =>
Kleisli m (Coprod (->) a b) (Coprod (->) b a)
swapS = (Coprod (Kleisli m) a b -> Coprod (Kleisli m) b a)
-> Kleisli m (Coprod (Kleisli m) a b) (Coprod (Kleisli m) b a)
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Coprod (Kleisli m) a b -> Coprod (Kleisli m) b a
forall a b. Ok2 (->) a b => Coprod (->) a b -> Coprod (->) b a
forall (k :: Type -> Type -> Type) a b.
(BraidedSCat k, Ok2 k a b) =>
k (Coprod (->) a b) (Coprod (->) b a)
swapS

instance Monad m => CoproductCat (Kleisli m) where
  inl :: forall a b. Ok2 (Kleisli m) a b => Kleisli m a (Coprod k a b)
inl = (a -> Coprod (Kleisli m) a b)
-> Kleisli m a (Coprod (Kleisli m) a b)
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> Coprod (Kleisli m) a b
forall a b. Ok2 (->) a b => a -> Coprod k a b
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl
  inr :: forall a b. Ok2 (Kleisli m) a b => Kleisli m b (Coprod k a b)
inr = (b -> Coprod (Kleisli m) a b)
-> Kleisli m b (Coprod (Kleisli m) a b)
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr b -> Coprod (Kleisli m) a b
forall a b. Ok2 (->) a b => b -> Coprod k a b
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr
  jam :: forall a. Ok (Kleisli m) a => Kleisli m (Coprod k a a) a
jam = (Coprod (Kleisli m) a a -> a)
-> Kleisli m (Coprod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Coprod (Kleisli m) a a -> a
forall a. Ok (->) a => Coprod k a a -> a
forall (k :: Type -> Type -> Type) a.
(CoproductCat k, Ok k a) =>
k (Coprod k a a) a
jam

-- f :: a -> m c
-- g :: b -> m c
-- h :: a :+ b -> m c

--   want :: a -> m (a :+ b)

instance MonoidalSCat U2 where
  U2 c a
U2 +++ :: forall a b c d.
Ok4 U2 a b c d =>
U2 c a -> U2 d b -> U2 (Coprod k c d) (Coprod k a b)
+++ U2 d b
U2 = U2 (Coprod U2 c d) (Coprod U2 a b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance BraidedSCat U2 where swapS :: forall a b. Ok2 U2 a b => U2 (Coprod (->) a b) (Coprod (->) b a)
swapS = U2 (Coprod U2 a b) (Coprod U2 b a)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (BraidedSCat k, BraidedSCat k') => BraidedSCat (k :**: k') where
  swapS :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' (Coprod (->) a b) (Coprod (->) b a)
swapS = k (Coprod k a b) (Coprod k b a)
forall a b. Ok2 k a b => k (Coprod (->) a b) (Coprod (->) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedSCat k, Ok2 k a b) =>
k (Coprod (->) a b) (Coprod (->) b a)
swapS k (Coprod k a b) (Coprod k b a)
-> k' (Coprod k a b) (Coprod k b a)
-> (:**:) k k' (Coprod k a b) (Coprod k b a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Coprod k a b) (Coprod k b a)
forall a b. Ok2 k' a b => k' (Coprod (->) a b) (Coprod (->) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedSCat k, Ok2 k a b) =>
k (Coprod (->) a b) (Coprod (->) b a)
swapS
  PINLINER(swapS)

instance CoproductCat U2 where
  inl :: forall a b. Ok2 U2 a b => U2 a (Coprod k a b)
inl = U2 a (Coprod U2 a b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  inr :: forall a b. Ok2 U2 a b => U2 b (Coprod k a b)
inr = U2 b (Coprod U2 a b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  jam :: forall a. Ok U2 a => U2 (Coprod k a a) a
jam = U2 (Coprod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (AssociativeSCat k, AssociativeSCat k') => AssociativeSCat (k :**: k') where
  lassocS :: forall a b c.
Oks (k :**: k') '[a, b, c] =>
(:**:)
  k
  k'
  (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
lassocS = k (Coprod k a (Coprod k b c)) (Coprod k (Coprod k a b) c)
forall a b c.
Oks k '[a, b, c] =>
k (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
forall (k :: Type -> Type -> Type) a b c.
(AssociativeSCat k, Oks k '[a, b, c]) =>
k (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
lassocS k (Coprod k a (Coprod k b c)) (Coprod k (Coprod k a b) c)
-> k' (Coprod k a (Coprod k b c)) (Coprod k (Coprod k a b) c)
-> (:**:)
     k k' (Coprod k a (Coprod k b c)) (Coprod k (Coprod k a b) c)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Coprod k a (Coprod k b c)) (Coprod k (Coprod k a b) c)
forall a b c.
Oks k' '[a, b, c] =>
k'
  (Coprod (->) a (Coprod (->) b c)) (Coprod (->) (Coprod (->) a b) c)
forall (k :: Type -> Type -> Type) a b c.
(AssociativeSCat k, Oks k '[a, b, c]) =>
k (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
lassocS
  rassocS :: forall a b c.
Oks (k :**: k') '[a, b, c] =>
(:**:)
  k
  k'
  (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
rassocS = k (Coprod k (Coprod k a b) c) (Coprod k a (Coprod k b c))
forall a b c.
Oks k '[a, b, c] =>
k (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
forall (k :: Type -> Type -> Type) a b c.
(AssociativeSCat k, Oks k '[a, b, c]) =>
k (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
rassocS k (Coprod k (Coprod k a b) c) (Coprod k a (Coprod k b c))
-> k' (Coprod k (Coprod k a b) c) (Coprod k a (Coprod k b c))
-> (:**:)
     k k' (Coprod k (Coprod k a b) c) (Coprod k a (Coprod k b c))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Coprod k (Coprod k a b) c) (Coprod k a (Coprod k b c))
forall a b c.
Oks k' '[a, b, c] =>
k'
  (Coprod (->) (Coprod (->) a b) c) (Coprod (->) a (Coprod (->) b c))
forall (k :: Type -> Type -> Type) a b c.
(AssociativeSCat k, Oks k '[a, b, c]) =>
k (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
rassocS
  PINLINER(lassocS)
  PINLINER(rassocS)

instance (MonoidalSCat k, MonoidalSCat k') => MonoidalSCat (k :**: k') where
  (k c a
f :**: k' c a
f') +++ :: forall a b c d.
Ok4 (k :**: k') a b c d =>
(:**:) k k' c a
-> (:**:) k k' d b -> (:**:) k k' (Coprod k c d) (Coprod k a b)
+++ (k d b
g :**: k' d b
g') = (k c a
f k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k d b
g) k (Coprod k c d) (Coprod k a b)
-> k' (Coprod k c d) (Coprod k a b)
-> (:**:) k k' (Coprod k c d) (Coprod k a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: (k' c a
f' k' c a -> k' d b -> k' (Coprod k c d) (Coprod k a b)
forall a b c d.
Ok4 k' a b c d =>
k' c a -> k' d b -> k' (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k' d b
g')
  left :: forall a a' b.
Oks (k :**: k') '[a, b, a'] =>
(:**:) k k' a a' -> (:**:) k k' (Coprod k a b) (Coprod k a' b)
left (k a a'
f :**: k' a a'
f') = k a a' -> k (Coprod k a b) (Coprod k a' b)
forall a a' b.
Oks k '[a, b, a'] =>
k a a' -> k (Coprod k a b) (Coprod k a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalSCat k, Oks k '[a, b, a']) =>
k a a' -> k (Coprod k a b) (Coprod k a' b)
left k a a'
f k (Coprod k a b) (Coprod k a' b)
-> k' (Coprod k a b) (Coprod k a' b)
-> (:**:) k k' (Coprod k a b) (Coprod k a' b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a' -> k' (Coprod k a b) (Coprod k a' b)
forall a a' b.
Oks k' '[a, b, a'] =>
k' a a' -> k' (Coprod k a b) (Coprod k a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalSCat k, Oks k '[a, b, a']) =>
k a a' -> k (Coprod k a b) (Coprod k a' b)
left k' a a'
f'
  right :: forall a b b'.
Oks (k :**: k') '[a, b, b'] =>
(:**:) k k' b b' -> (:**:) k k' (Coprod k a b) (Coprod k a b')
right (k b b'
f :**: k' b b'
f') = k b b' -> k (Coprod k a b) (Coprod k a b')
forall a b b'.
Oks k '[a, b, b'] =>
k b b' -> k (Coprod k a b) (Coprod k a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalSCat k, Oks k '[a, b, b']) =>
k b b' -> k (Coprod k a b) (Coprod k a b')
right k b b'
f k (Coprod k a b) (Coprod k a b')
-> k' (Coprod k a b) (Coprod k a b')
-> (:**:) k k' (Coprod k a b) (Coprod k a b')
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' b b' -> k' (Coprod k a b) (Coprod k a b')
forall a b b'.
Oks k' '[a, b, b'] =>
k' b b' -> k' (Coprod k a b) (Coprod k a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalSCat k, Oks k '[a, b, b']) =>
k b b' -> k (Coprod k a b) (Coprod k a b')
right k' b b'
f'
  PINLINER((+++))
  PINLINER(left)
  PINLINER(right)

instance (CoproductCat k, CoproductCat k') => CoproductCat (k :**: k') where
  inl :: forall a b. Ok2 (k :**: k') a b => (:**:) k k' a (Coprod k a b)
inl = k a (Coprod k a b)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl k a (Coprod k a b)
-> k' a (Coprod k a b) -> (:**:) k k' a (Coprod k a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (Coprod k a b)
forall a b. Ok2 k' a b => k' a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl
  inr :: forall a b. Ok2 (k :**: k') a b => (:**:) k k' b (Coprod k a b)
inr = k b (Coprod k a b)
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr k b (Coprod k a b)
-> k' b (Coprod k a b) -> (:**:) k k' b (Coprod k a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' b (Coprod k a b)
forall a b. Ok2 k' a b => k' b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr
  jam :: forall a. Ok (k :**: k') a => (:**:) k k' (Coprod k a a) a
jam = k (Coprod k a a) a
forall a. Ok k a => k (Coprod k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductCat k, Ok k a) =>
k (Coprod k a a) a
jam k (Coprod k a a) a
-> k' (Coprod k a a) a -> (:**:) k k' (Coprod k a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Coprod k a a) a
forall a. Ok k' a => k' (Coprod k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductCat k, Ok k a) =>
k (Coprod k a a) a
jam
  PINLINER(inl)
  PINLINER(inr)
  PINLINER(jam)

{--------------------------------------------------------------------
    Abelian categories
--------------------------------------------------------------------}

#if 1

type AbelianCat k =
  (MProductCat k, CoproductPCat k, TerminalCat k, CoterminalCat k, OkAdd k)

zeroC :: (AbelianCat k, Ok2 k a b) => a `k` b
zeroC :: forall (k :: Type -> Type -> Type) a b.
(AbelianCat k, Ok2 k a b) =>
k a b
zeroC = k () b
forall a. Ok k a => k () a
forall (k :: Type -> Type -> Type) a.
(CoterminalCat k, Ok k a) =>
k () a
ti k () b -> k a () -> k a b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a ()
forall a. Ok k a => k a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it

plusC :: forall k a b. (AbelianCat k, Ok2 k a b) => Binop (a `k` b)
k a b
f plusC :: forall (k :: Type -> Type -> Type) a b.
(AbelianCat k, Ok2 k a b) =>
Binop (k a b)
`plusC` k a b
g = k (b :* b) b
forall a. Ok k a => k (CoprodP k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductPCat k, Ok k a) =>
k (CoprodP k a a) a
jamP k (b :* b) b -> k a (b :* b) -> k a b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (k a b
f k a b -> k a b -> k (a :* a) (b :* b)
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k a b
g) k (a :* a) (b :* b) -> k a (a :* a) -> k a (b :* b)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a (a :* a)
forall a. Ok k a => k a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
  (Con (Sat (Ok k) (b :* b)) => k a b)
-> ((Sat (Ok k) b && Sat (Ok k) b) |- Sat (Ok k) (b :* b)) -> k a b
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @b @b
  (Con (Sat (Ok k) (a :* a)) => k a b)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :* a)) -> k a b
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
  (Con (Sat Additive b) => k a b)
-> (Sat (Ok k) b |- Sat Additive b) -> k a b
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkAdd k =>
Ok' k a |- Sat Additive a
okAdd  @k @b

#else

class AbelianCat k where
  zeroC :: forall a b. (Ok2 k a b, Additive b) => a `k` b
  plusC :: forall a b. (Ok2 k a b, Additive b) => Binop (a `k` b)
  default plusC :: forall a b. (Ok2 k a b, Additive b, ProductCat k, CoproductPCat k)
                => Binop (a `k` b)
  -- Two reasonable defaults
#if 1
  f `plusC` g = (f |||| g) . dup <+ okProd @k @a @a
#else
  f `plusC` g = jamP . (f &&& g) <+ okProd @k @b @b
#endif

-- TODO: probably remove the Additive constraints here, but use OkAdd k in the
-- plusC default.

instance AbelianCat U2 where
  zeroC = U2
  U2 `plusC` U2 = U2

instance (AbelianCat k, AbelianCat k') => AbelianCat (k :**: k') where
  zeroC = zeroC :**: zeroC
  (f :**: f') `plusC` (g :**: g') = (f `plusC` g) :**: (f' `plusC` g')
  PINLINER(zeroC)
  PINLINER(plusC)

-- TODO: relate AbelianCat to ProductCat and CoproductPCat.
-- Also to IxProductCat and IxCoproductPCat.

#endif

{--------------------------------------------------------------------
    A dual to ProductCat. Temporary workaround.
--------------------------------------------------------------------}

-- TODO: eliminate CoproductPCat in favor of when we have associated products,
-- coproducts, etc.

type CoprodP k = Prod k

type OkCoprodP k = OkProd k

okCoprodP :: forall k a b. OkCoprodP k
           => Ok' k a && Ok' k b |- Ok' k (CoprodP k a b)
okCoprodP :: forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okCoprodP = (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a, b)
forall a b. (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :* b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp
{-# INLINE okCoprodP #-}

-- | Category with coproduct as Cartesian product.
class BraidedPCat k => CoproductPCat k where
  inlP :: Ok2 k a b => a `k` CoprodP k a b
  inrP :: Ok2 k a b => b `k` CoprodP k a b
  jamP :: Ok k a => CoprodP k a a `k` a

type MCoproductPCat k = (CoproductPCat k, MonoidalPCat k)

infixr 2 ||||

(||||) :: forall k a c d. (MCoproductPCat k, Ok3 k a c d)
       => (c `k` a) -> (d `k` a) -> (CoprodP k c d `k` a)
k c a
f |||| :: forall (k :: Type -> Type -> Type) a c d.
(MCoproductPCat k, Ok3 k a c d) =>
k c a -> k d a -> k (CoprodP k c d) a
|||| k d a
g = k (CoprodP k a a) a
forall a. Ok k a => k (CoprodP k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductPCat k, Ok k a) =>
k (CoprodP k a a) a
jamP k (CoprodP k a a) a
-> k (CoprodP k c d) (CoprodP k a a) -> k (CoprodP k c d) a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (k c a
f k c a -> k d a -> k (CoprodP k c d) (CoprodP k a a)
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k d a
g)
         (Con (Sat (Ok k) (CoprodP k a a)) => k (CoprodP k c d) a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (CoprodP k a a))
-> k (CoprodP k c d) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okCoprodP @k @a @a
         (Con (Sat (Ok k) (CoprodP k c d)) => k (CoprodP k c d) a)
-> ((Sat (Ok k) c && Sat (Ok k) d) |- Sat (Ok k) (CoprodP k c d))
-> k (CoprodP k c d) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okCoprodP @k @c @d
{-# INLINE (||||) #-}


-- Don't bother with left, right, lassocS, rassocS, and misc helpers.

instance CoproductPCat U2 where
  inlP :: forall a b. Ok2 U2 a b => U2 a (CoprodP U2 a b)
inlP = U2 a (CoprodP U2 a b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  inrP :: forall a b. Ok2 U2 a b => U2 b (CoprodP U2 a b)
inrP = U2 b (CoprodP U2 a b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  jamP :: forall a. Ok U2 a => U2 (CoprodP k a a) a
jamP = U2 (CoprodP U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (CoproductPCat k, CoproductPCat k') => CoproductPCat (k :**: k') where
  inlP :: forall a b. Ok2 (k :**: k') a b => (:**:) k k' a (CoprodP U2 a b)
inlP = k a (CoprodP k a b)
forall a b. Ok2 k a b => k a (CoprodP U2 a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductPCat k, Ok2 k a b) =>
k a (CoprodP U2 a b)
inlP k a (CoprodP k a b)
-> k' a (CoprodP k a b) -> (:**:) k k' a (CoprodP k a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (CoprodP k a b)
forall a b. Ok2 k' a b => k' a (CoprodP U2 a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductPCat k, Ok2 k a b) =>
k a (CoprodP U2 a b)
inlP
  inrP :: forall a b. Ok2 (k :**: k') a b => (:**:) k k' b (CoprodP U2 a b)
inrP = k b (CoprodP k a b)
forall a b. Ok2 k a b => k b (CoprodP U2 a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductPCat k, Ok2 k a b) =>
k b (CoprodP U2 a b)
inrP k b (CoprodP k a b)
-> k' b (CoprodP k a b) -> (:**:) k k' b (CoprodP k a b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' b (CoprodP k a b)
forall a b. Ok2 k' a b => k' b (CoprodP U2 a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductPCat k, Ok2 k a b) =>
k b (CoprodP U2 a b)
inrP
  jamP :: forall a. Ok (k :**: k') a => (:**:) k k' (CoprodP k a a) a
jamP = k (CoprodP k a a) a
forall a. Ok k a => k (CoprodP k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductPCat k, Ok k a) =>
k (CoprodP k a a) a
jamP k (CoprodP k a a) a
-> k' (CoprodP k a a) a -> (:**:) k k' (CoprodP k a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (CoprodP k a a) a
forall a. Ok k' a => k' (CoprodP k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductPCat k, Ok k a) =>
k (CoprodP k a a) a
jamP
  PINLINER(inlP)
  PINLINER(inrP)
  PINLINER(jamP)

-- Scalar multiplication

class ScalarCat k a where
  scale :: a -> (a `k` a)

instance Num a => ScalarCat (->) a where
  scale :: a -> a -> a
scale = a -> a -> a
forall a. Num a => a -> a -> a
(*)  -- I don't think I want to inline (*)
  PINLINER(scale)

instance ScalarCat U2 a where
  scale :: a -> U2 a a
scale = U2 a a -> a -> U2 a a
forall a. Ok (->) a => U2 a a -> a -> U2 a a
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (ScalarCat k a, ScalarCat k' a) => ScalarCat (k :**: k') a where
  scale :: a -> (:**:) k k' a a
scale a
s = a -> k a a
forall (k :: Type -> Type -> Type) a. ScalarCat k a => a -> k a a
scale a
s k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: a -> k' a a
forall (k :: Type -> Type -> Type) a. ScalarCat k a => a -> k a a
scale a
s
  PINLINER(scale)

type LinearCat k a = (MProductCat k, CoproductPCat k, ScalarCat k a, Ok k a)

{--------------------------------------------------------------------
    Distributive
--------------------------------------------------------------------}

class DistribCat k where
  distl :: forall a u v. Ok3 k a u v
        => Prod k a (Coprod k u v) `k` Coprod k (Prod k a u) (Prod k a v)
  distr :: forall u v b. Ok3 k u v b
        => Prod k (Coprod k u v) b `k` Coprod k (Prod k u b) (Prod k v b)
  default distl :: forall a u v. (MonoidalSCat k, BraidedPCat k, Ok3 k a u v)
                => Prod k a (Coprod k u v) `k` Coprod k (Prod k a u) (Prod k a v)
  distl = (k (u :* a) (Prod k a u)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP k (u :* a) (Prod k a u)
-> k (v :* a) (Prod k a v)
-> k ((u :* a) :+ (v :* a)) (Coprod k (Prod k a u) (Prod k a v))
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k (v :* a) (Prod k a v)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP) k ((u :* a) :+ (v :* a)) (Coprod k (Prod k a u) (Prod k a v))
-> k (Prod k a (u :+ v)) ((u :* a) :+ (v :* a))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k ((u :+ v) :* a) ((u :* a) :+ (v :* a))
forall u v b.
Ok3 k u v b =>
k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
forall (k :: Type -> Type -> Type) u v b.
(DistribCat k, Ok3 k u v b) =>
k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
distr k ((u :+ v) :* a) ((u :* a) :+ (v :* a))
-> k (Prod k a (u :+ v)) ((u :+ v) :* a)
-> k (Prod k a (u :+ v)) ((u :* a) :+ (v :* a))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a (u :+ v)) ((u :+ v) :* a)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP
    (Con (Sat (Ok k) ((u :+ v) :* a)) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) (u :+ v) && Sat (Ok k) a)
    |- Sat (Ok k) ((u :+ v) :* a))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @(Coprod k u v) @a
    (Con (Sat (Ok k) ((u :* a) :+ (v :* a))) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) (u :* a) && Sat (Ok k) (v :* a))
    |- Sat (Ok k) ((u :* a) :+ (v :* a)))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @(Prod k u a) @(Prod k v a)
    (Con (Sat (Ok k) (u :* a)) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) u && Sat (Ok k) a) |- Sat (Ok k) (u :* a))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @u @a
    (Con (Sat (Ok k) (v :* a)) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) v && Sat (Ok k) a) |- Sat (Ok k) (v :* a))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @v @a
    (Con (Sat (Ok k) (Coprod k (Prod k a u) (Prod k a v))) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) (Prod k a u) && Sat (Ok k) (Prod k a v))
    |- Sat (Ok k) (Coprod k (Prod k a u) (Prod k a v)))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @(Prod k a u) @(Prod k a v)
    (Con (Sat (Ok k) (Prod k a u)) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) a && Sat (Ok k) u) |- Sat (Ok k) (Prod k a u))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @a @u
    (Con (Sat (Ok k) (Prod k a v)) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) a && Sat (Ok k) v) |- Sat (Ok k) (Prod k a v))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @a @v
    (Con (Sat (Ok k) (Prod k a (u :+ v))) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) a && Sat (Ok k) (u :+ v))
    |- Sat (Ok k) (Prod k a (u :+ v)))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @a @(Coprod k u v)
    (Con (Sat (Ok k) (u :+ v)) =>
 k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v)))
-> ((Sat (Ok k) u && Sat (Ok k) v) |- Sat (Ok k) (u :+ v))
-> k (Prod k a (u :+ v)) (Coprod k (Prod k a u) (Prod k a v))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @u @v
  {-# INLINE distl #-}
  default distr :: forall u v b. (MonoidalSCat k, BraidedPCat k, Ok3 k u v b)
                => Prod k (Coprod k u v) b `k` Coprod k (Prod k u b) (Prod k v b)
  distr = (k (b :* u) (Prod k u b)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP k (b :* u) (Prod k u b)
-> k (b :* v) (Prod k v b)
-> k ((b :* u) :+ (b :* v)) (Coprod k (Prod k u b) (Prod k v b))
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k (b :* v) (Prod k v b)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP) k ((b :* u) :+ (b :* v)) (Coprod k (Prod k u b) (Prod k v b))
-> k (Prod k (u :+ v) b) ((b :* u) :+ (b :* v))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (b :* (u :+ v)) ((b :* u) :+ (b :* v))
forall a u v.
Ok3 k a u v =>
k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
forall (k :: Type -> Type -> Type) a u v.
(DistribCat k, Ok3 k a u v) =>
k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
distl k (b :* (u :+ v)) ((b :* u) :+ (b :* v))
-> k (Prod k (u :+ v) b) (b :* (u :+ v))
-> k (Prod k (u :+ v) b) ((b :* u) :+ (b :* v))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k (u :+ v) b) (b :* (u :+ v))
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP
    (Con (Sat (Ok k) (b :* (u :+ v))) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) b && Sat (Ok k) (u :+ v))
    |- Sat (Ok k) (b :* (u :+ v)))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @b @(Coprod k u v)
    (Con (Sat (Ok k) ((b :* u) :+ (b :* v))) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) (b :* u) && Sat (Ok k) (b :* v))
    |- Sat (Ok k) ((b :* u) :+ (b :* v)))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @(Prod k b u) @(Prod k b v)
    (Con (Sat (Ok k) (b :* u)) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) b && Sat (Ok k) u) |- Sat (Ok k) (b :* u))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @b @u
    (Con (Sat (Ok k) (b :* v)) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) b && Sat (Ok k) v) |- Sat (Ok k) (b :* v))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @b @v
    (Con (Sat (Ok k) (Coprod k (Prod k u b) (Prod k v b))) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) (Prod k u b) && Sat (Ok k) (Prod k v b))
    |- Sat (Ok k) (Coprod k (Prod k u b) (Prod k v b)))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @(Prod k u b) @(Prod k v b)
    (Con (Sat (Ok k) (Prod k u b)) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) u && Sat (Ok k) b) |- Sat (Ok k) (Prod k u b))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @u @b
    (Con (Sat (Ok k) (Prod k v b)) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) v && Sat (Ok k) b) |- Sat (Ok k) (Prod k v b))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @v @b
    (Con (Sat (Ok k) (Prod k (u :+ v) b)) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) (u :+ v) && Sat (Ok k) b)
    |- Sat (Ok k) (Prod k (u :+ v) b))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd   @k @(Coprod k u v) @b
    (Con (Sat (Ok k) (u :+ v)) =>
 k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b)))
-> ((Sat (Ok k) u && Sat (Ok k) v) |- Sat (Ok k) (u :+ v))
-> k (Prod k (u :+ v) b) (Coprod k (Prod k u b) (Prod k v b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkCoprod k =>
(Ok' k a && Ok' k b) |- Ok' k (Coprod k a b)
okCoprod @k @u @v
  {-# INLINE distr #-}
  {-# MINIMAL distl | distr #-}

-- instance DistribCat (->) where
--   distl (a,uv) = ((a,) +++ (a,)) uv
--   distr (uv,b) = ((,b) +++ (,b)) uv

instance DistribCat (->) where
  distl :: forall a u v.
Ok3 (->) a u v =>
Prod k a (Coprod k u v) -> Coprod k (Prod k a u) (Prod k a v)
distl (a
a,Left  u
u) = Prod (->) a u -> Either (Prod (->) a u) (Prod (->) a v)
forall a b. a -> Either a b
Left  (a
a,u
u)
  distl (a
a,Right v
v) = Prod (->) a v -> Either (Prod (->) a u) (Prod (->) a v)
forall a b. b -> Either a b
Right (a
a,v
v)
  distr :: forall u v b.
Ok3 (->) u v b =>
Prod k (Coprod k u v) b -> Coprod k (Prod k u b) (Prod k v b)
distr (Left  u
u,b
b) = Prod (->) u b -> Either (Prod (->) u b) (Prod (->) v b)
forall a b. a -> Either a b
Left  (u
u,b
b)
  distr (Right v
v,b
b) = Prod (->) v b -> Either (Prod (->) u b) (Prod (->) v b)
forall a b. b -> Either a b
Right (v
v,b
b)

instance DistribCat U2 where
  distl :: forall a u v.
Ok3 U2 a u v =>
U2 (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
distl = U2
  (Prod U2 a (Coprod U2 u v)) (Coprod U2 (Prod U2 a u) (Prod U2 a v))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  distr :: forall u v b.
Ok3 U2 u v b =>
U2 (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
distr = U2
  (Prod U2 (Coprod U2 u v) b) (Coprod U2 (Prod U2 u b) (Prod U2 v b))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (DistribCat k, DistribCat k') => DistribCat (k :**: k') where
  distl :: forall a u v.
Ok3 (k :**: k') a u v =>
(:**:)
  k k' (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
distl = k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
forall a u v.
Ok3 k a u v =>
k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
forall (k :: Type -> Type -> Type) a u v.
(DistribCat k, Ok3 k a u v) =>
k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
distl k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
-> k'
     (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
-> (:**:)
     k k' (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
forall a u v.
Ok3 k' a u v =>
k' (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
forall (k :: Type -> Type -> Type) a u v.
(DistribCat k, Ok3 k a u v) =>
k (Prod k a (Coprod k u v)) (Coprod k (Prod k a u) (Prod k a v))
distl
  distr :: forall u v b.
Ok3 (k :**: k') u v b =>
(:**:)
  k k' (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
distr = k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
forall u v b.
Ok3 k u v b =>
k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
forall (k :: Type -> Type -> Type) u v b.
(DistribCat k, Ok3 k u v b) =>
k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
distr k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
-> k'
     (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
-> (:**:)
     k k' (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
forall u v b.
Ok3 k' u v b =>
k' (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
forall (k :: Type -> Type -> Type) u v b.
(DistribCat k, Ok3 k u v b) =>
k (Prod k (Coprod k u v) b) (Coprod k (Prod k u b) (Prod k v b))
distr
  PINLINER(distl)
  PINLINER(distr)

{--------------------------------------------------------------------
    Exponentials
--------------------------------------------------------------------}

type OkExp k = OpCon (Exp k) (Ok' k)

okExp :: forall k a b. OkExp k
      => Ok' k a && Ok' k b |- Ok' k (Exp k a b)
okExp :: forall (k :: Type -> Type -> Type) a b.
OkExp k =>
(Ok' k a && Ok' k b) |- Ok' k (Exp k a b)
okExp = (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a -> b)
forall a b. (Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a -> b)
forall {k} (op :: k -> k -> k) (con :: k -> Type) (a :: k)
       (b :: k).
OpCon op con =>
(con a && con b) |- con (op a b)
inOp
{-# INLINE okExp #-}

-- #define ExpAsCat

#ifdef ExpAsCat
type Exp k = k
#else
type Exp k = (->)
#endif

class (OkExp k, ProductCat k) => ClosedCat k where
  -- type Exp k :: u -> u -> u
  apply   :: forall a b. Ok2 k a b => Prod k (Exp k a b) a `k` b
  apply = k (a -> b) (a -> b) -> k (Prod k (a -> b) a) b
forall a b c. Ok3 k a b c => k a (Exp k b c) -> k (Prod k a b) c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry k (a -> b) (a -> b)
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id
          (Con (Sat (Ok k) (a -> b)) => k (Prod k (a -> b) a) b)
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a -> b))
-> k (Prod k (a -> b) a) b
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkExp k =>
(Ok' k a && Ok' k b) |- Ok' k (Exp k a b)
okExp @k @a @b
  {-# INLINE apply #-}
  curry   :: Ok3 k a b c => (Prod k a b `k` c) -> (a `k` Exp k b c)
  uncurry :: forall a b c. Ok3 k a b c
          => (a `k` Exp k b c)  -> (Prod k a b `k` c)
  default uncurry :: forall a b c. (MonoidalPCat k, Ok3 k a b c)
                  => (a `k` Exp k b c)  -> (Prod k a b `k` c)
  uncurry k a (Exp k b c)
g = k (Exp k b c :* b) c
forall a b. Ok2 k a b => k (Prod k (Exp k a b) a) b
forall (k :: Type -> Type -> Type) a b.
(ClosedCat k, Ok2 k a b) =>
k (Prod k (Exp k a b) a) b
apply k (Exp k b c :* b) c
-> k (Prod k a b) (Exp k b c :* b) -> k (Prod k a b) c
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a (Exp k b c) -> k (Prod k a b) (Exp k b c :* b)
forall a a' b.
Ok3 k a b a' =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first k a (Exp k b c)
g
              (Con (Sat (Ok k) (Exp k b c :* b)) => k (Prod k a b) c)
-> ((Sat (Ok k) (Exp k b c) && Sat (Ok k) b)
    |- Sat (Ok k) (Exp k b c :* b))
-> k (Prod k a b) c
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @(Exp k b c) @b
              (Con (Sat (Ok k) (Prod k a b)) => k (Prod k a b) c)
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (Prod k a b))
-> k (Prod k a b) c
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @b
              (Con (Sat (Ok k) (Exp k b c)) => k (Prod k a b) c)
-> ((Sat (Ok k) b && Sat (Ok k) c) |- Sat (Ok k) (Exp k b c))
-> k (Prod k a b) c
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkExp k =>
(Ok' k a && Ok' k b) |- Ok' k (Exp k a b)
okExp  @k @b @c
  {-# INLINE uncurry #-}
  {-# MINIMAL curry, (apply | uncurry) #-}

--   apply   :: (Ok2 k a b, p ~ Prod k, e ~ Exp k) => ((a `e` b) `p` a) `k` b

instance ClosedCat (->) where
  -- type Exp (->) = (->)
  apply :: forall a b. Ok2 (->) a b => Prod k (Exp k a b) a -> b
apply   = (Exp (->) a b -> Exp (->) a b) -> (Exp (->) a b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
P.uncurry Exp (->) a b -> Exp (->) a b
forall a b. (a -> b) -> a -> b
($)
  curry :: forall a b c.
Ok3 (->) a b c =>
(Prod (->) a b -> c) -> a -> Exp (->) b c
curry   = ((a, b) -> c) -> a -> b -> c
forall a b c. ((a, b) -> c) -> a -> b -> c
P.curry
  uncurry :: forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
uncurry = (a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
P.uncurry

-- TODO: do we want inline for apply, curry, and uncurry?

applyK   ::            Kleisli m (Kleisli m a b :* a) b
curryK   :: Monad m => Kleisli m (a :* b) c -> Kleisli m a (Kleisli m b c)
uncurryK :: Monad m => Kleisli m a (Kleisli m b c) -> Kleisli m (a :* b) c

applyK :: forall (m :: Type -> Type) a b. Kleisli m (Kleisli m a b :* a) b
applyK   = O (Kleisli m (Kleisli m a b :* a) b)
-> Kleisli m (Kleisli m a b :* a) b
forall n. Newtype n => O n -> n
pack (Prod (->) (Exp (->) a (m b)) a -> m b
forall a b. Ok2 (->) a b => Prod k (Exp k a b) a -> b
forall (k :: Type -> Type -> Type) a b.
(ClosedCat k, Ok2 k a b) =>
k (Prod k (Exp k a b) a) b
apply (Prod (->) (Exp (->) a (m b)) a -> m b)
-> ((Kleisli m a b :* a) -> Prod (->) (Exp (->) a (m b)) a)
-> (Kleisli m a b :* a)
-> m b
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (Kleisli m a b -> Exp (->) a (m b))
-> (Kleisli m a b :* a) -> Prod (->) (Exp (->) a (m b)) a
forall a a' b.
Ok3 (->) a b a' =>
(a -> a') -> Prod (|-) a b -> Prod (|-) a' b
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first Kleisli m a b -> O (Kleisli m a b)
Kleisli m a b -> Exp (->) a (m b)
forall n. Newtype n => n -> O n
unpack)
curryK :: forall (m :: Type -> Type) a b c.
Monad m =>
Kleisli m (a :* b) c -> Kleisli m a (Kleisli m b c)
curryK   = (O (Kleisli m (a :* b) c) -> O (Kleisli m a (Kleisli m b c)))
-> Kleisli m (a :* b) c -> Kleisli m a (Kleisli m b c)
forall p q. (Newtype p, Newtype q) => (O p -> O q) -> p -> q
inNew ((O (Kleisli m (a :* b) c) -> O (Kleisli m a (Kleisli m b c)))
 -> Kleisli m (a :* b) c -> Kleisli m a (Kleisli m b c))
-> (O (Kleisli m (a :* b) c) -> O (Kleisli m a (Kleisli m b c)))
-> Kleisli m (a :* b) c
-> Kleisli m a (Kleisli m b c)
forall a b. (a -> b) -> a -> b
$ \ O (Kleisli m (a :* b) c)
h -> Kleisli m b c -> m (Kleisli m b c)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Kleisli m b c -> m (Kleisli m b c))
-> (a -> Kleisli m b c) -> a -> m (Kleisli m b c)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. O (Kleisli m b c) -> Kleisli m b c
Exp (->) b (m c) -> Kleisli m b c
forall n. Newtype n => O n -> n
pack (Exp (->) b (m c) -> Kleisli m b c)
-> (a -> Exp (->) b (m c)) -> a -> Kleisli m b c
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((a :* b) -> m c) -> a -> Exp (->) b (m c)
forall a b c.
Ok3 (->) a b c =>
(Prod (->) a b -> c) -> a -> Exp (->) b c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry O (Kleisli m (a :* b) c)
(a :* b) -> m c
h
uncurryK :: forall (m :: Type -> Type) a b c.
Monad m =>
Kleisli m a (Kleisli m b c) -> Kleisli m (a :* b) c
uncurryK = (O (Kleisli m a (Kleisli m b c)) -> O (Kleisli m (a :* b) c))
-> Kleisli m a (Kleisli m b c) -> Kleisli m (a :* b) c
forall p q. (Newtype p, Newtype q) => (O p -> O q) -> p -> q
inNew ((O (Kleisli m a (Kleisli m b c)) -> O (Kleisli m (a :* b) c))
 -> Kleisli m a (Kleisli m b c) -> Kleisli m (a :* b) c)
-> (O (Kleisli m a (Kleisli m b c)) -> O (Kleisli m (a :* b) c))
-> Kleisli m a (Kleisli m b c)
-> Kleisli m (a :* b) c
forall a b. (a -> b) -> a -> b
$ \ O (Kleisli m a (Kleisli m b c))
f -> \ (a
a,b
b) -> O (Kleisli m a (Kleisli m b c))
a -> m (Kleisli m b c)
f a
a m (Kleisli m b c) -> (Kleisli m b c -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((b -> m c) -> b -> m c
forall a b. (a -> b) -> a -> b
$ b
b) ((b -> m c) -> m c)
-> (Kleisli m b c -> b -> m c) -> Kleisli m b c -> m c
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. Kleisli m b c -> O (Kleisli m b c)
Kleisli m b c -> b -> m c
forall n. Newtype n => n -> O n
unpack

#if 0
instance Monad m => ClosedCat (Kleisli m) where
  -- type Exp (Kleisli m) = Kleisli m
  apply   = applyK
  curry   = curryK
  uncurry = uncurryK
#endif

instance ClosedCat U2 where
  apply :: forall a b. Ok2 U2 a b => U2 (Prod k (Exp k a b) a) b
apply = U2 (Prod U2 (Exp U2 a b) a) b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  curry :: forall a b c.
Ok3 U2 a b c =>
U2 (Prod (->) a b) c -> U2 a (Exp (->) b c)
curry U2 (Prod U2 a b) c
U2 = U2 a (Exp U2 b c)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  uncurry :: forall a b c. Ok3 U2 a b c => U2 a (Exp k b c) -> U2 (Prod k a b) c
uncurry U2 a (Exp U2 b c)
U2 = U2 (Prod U2 a b) c
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

#ifdef ExpAsCat
instance (ClosedCat k, ClosedCat k') => ClosedCat (k :**: k') where
  apply = (apply . first exl) :**: undefined
  -- apply = (apply . first exl) :**: (apply . first exr)

  -- apply = (apply . exl) :**: (apply . exr)
  -- apply :: forall a b. (Ok2 k a b, Ok2 k' a b)
  --       => (k :**: k') ((k :**: k') a b :* a) b
  -- apply = undefined -- (apply . exl) :**: _
  curry (f :**: f') = curry f :**: curry f'
  uncurry (g :**: g') = uncurry g :**: uncurry g'
  PINLINER(apply)
  PINLINER(curry)
  PINLINER(uncurry)
#else
instance (ClosedCat k, ClosedCat k') => ClosedCat (k :**: k') where
  apply :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' (Prod k (Exp k a b) a) b
apply = k (Prod k (Exp k a b) a) b
forall a b. Ok2 k a b => k (Prod k (Exp k a b) a) b
forall (k :: Type -> Type -> Type) a b.
(ClosedCat k, Ok2 k a b) =>
k (Prod k (Exp k a b) a) b
apply k (Prod k (Exp k a b) a) b
-> k' (Prod k (Exp k a b) a) b
-> (:**:) k k' (Prod k (Exp k a b) a) b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k (Exp k a b) a) b
forall a b. Ok2 k' a b => k' (Prod k (Exp k a b) a) b
forall (k :: Type -> Type -> Type) a b.
(ClosedCat k, Ok2 k a b) =>
k (Prod k (Exp k a b) a) b
apply
  -- apply = (apply . exl) :**: (apply . exr)
  -- apply :: forall a b. (Ok2 k a b, Ok2 k' a b)
  --       => (k :**: k') ((k :**: k') a b :* a) b
  -- apply = undefined -- (apply . exl) :**: _
  curry :: forall a b c.
Ok3 (k :**: k') a b c =>
(:**:) k k' (Prod (->) a b) c -> (:**:) k k' a (Exp (->) b c)
curry (k (Prod (k :**: k') a b) c
f :**: k' (Prod (k :**: k') a b) c
f') = k (Prod (k :**: k') a b) c -> k a (Exp k b c)
forall a b c.
Ok3 k a b c =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry k (Prod (k :**: k') a b) c
f k a (Exp k b c) -> k' a (Exp k b c) -> (:**:) k k' a (Exp k b c)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a b) c -> k' a (Exp k b c)
forall a b c.
Ok3 k' a b c =>
k' (Prod (->) a b) c -> k' a (Exp (->) b c)
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry k' (Prod (k :**: k') a b) c
f'
  uncurry :: forall a b c.
Ok3 (k :**: k') a b c =>
(:**:) k k' a (Exp k b c) -> (:**:) k k' (Prod k a b) c
uncurry (k a (Exp (k :**: k') b c)
g :**: k' a (Exp (k :**: k') b c)
g') = k a (Exp (k :**: k') b c) -> k (Prod k a b) c
forall a b c. Ok3 k a b c => k a (Exp k b c) -> k (Prod k a b) c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry k a (Exp (k :**: k') b c)
g k (Prod k a b) c -> k' (Prod k a b) c -> (:**:) k k' (Prod k a b) c
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (Exp (k :**: k') b c) -> k' (Prod k a b) c
forall a b c. Ok3 k' a b c => k' a (Exp k b c) -> k' (Prod k a b) c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry k' a (Exp (k :**: k') b c)
g'
  PINLINER(apply)
  PINLINER(curry)
  PINLINER(uncurry)
#endif

-- An alternative to ClosedCat
class OkExp k => FlipCat k where
  flipC  :: Ok3 k a b c => (a `k` (b -> c)) -> (b -> (a `k` c))
  flipC' :: Ok3 k a b c => (b -> (a `k` c)) -> (a `k` (b -> c))

instance FlipCat (->) where
  flipC :: forall a b c. Ok3 (->) a b c => (a -> (b -> c)) -> b -> a -> c
flipC  = (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip
  flipC' :: forall a b c. Ok3 (->) a b c => (b -> a -> c) -> a -> (b -> c)
flipC' = (b -> a -> c) -> a -> b -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip

-- TODO: inline?

instance FlipCat U2 where
  flipC :: forall a b c. Ok3 U2 a b c => U2 a (b -> c) -> b -> U2 a c
flipC  U2 a (b -> c)
U2 = U2 a c -> b -> U2 a c
forall a. Ok (->) a => U2 a c -> a -> U2 a c
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const U2 a c
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  flipC' :: forall a b c. Ok3 U2 a b c => (b -> U2 a c) -> U2 a (b -> c)
flipC' b -> U2 a c
_ = U2 a (b -> c)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (FlipCat k, FlipCat k') => FlipCat (k :**: k') where
  flipC :: forall a b c.
Ok3 (k :**: k') a b c =>
(:**:) k k' a (b -> c) -> b -> (:**:) k k' a c
flipC (k a (b -> c)
f :**: k' a (b -> c)
f') b
b = k a (b -> c) -> b -> k a c
forall a b c. Ok3 k a b c => k a (b -> c) -> b -> k a c
forall (k :: Type -> Type -> Type) a b c.
(FlipCat k, Ok3 k a b c) =>
k a (b -> c) -> b -> k a c
flipC k a (b -> c)
f b
b k a c -> k' a c -> (:**:) k k' a c
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (b -> c) -> b -> k' a c
forall a b c. Ok3 k' a b c => k' a (b -> c) -> b -> k' a c
forall (k :: Type -> Type -> Type) a b c.
(FlipCat k, Ok3 k a b c) =>
k a (b -> c) -> b -> k a c
flipC k' a (b -> c)
f' b
b
  flipC' :: forall a b c.
Ok3 (k :**: k') a b c =>
(b -> (:**:) k k' a c) -> (:**:) k k' a (b -> c)
flipC' b -> (:**:) k k' a c
h = (b -> k a c) -> k a (b -> c)
forall a b c. Ok3 k a b c => (b -> k a c) -> k a (b -> c)
forall (k :: Type -> Type -> Type) a b c.
(FlipCat k, Ok3 k a b c) =>
(b -> k a c) -> k a (b -> c)
flipC' ((:**:) k k' a c -> k a c
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b
exl2 ((:**:) k k' a c -> k a c) -> (b -> (:**:) k k' a c) -> b -> k a c
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. b -> (:**:) k k' a c
h) k a (b -> c) -> k' a (b -> c) -> (:**:) k k' a (b -> c)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: (b -> k' a c) -> k' a (b -> c)
forall a b c. Ok3 k' a b c => (b -> k' a c) -> k' a (b -> c)
forall (k :: Type -> Type -> Type) a b c.
(FlipCat k, Ok3 k a b c) =>
(b -> k a c) -> k a (b -> c)
flipC' ((:**:) k k' a c -> k' a c
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> q a b
exr2 ((:**:) k k' a c -> k' a c)
-> (b -> (:**:) k k' a c) -> b -> k' a c
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. b -> (:**:) k k' a c
h)

-- Hm. The use of exl2 and exr2 here suggest replication of effort

--                h  :: b -> (k :**: k') a c
--         exl2 . h  :: b -> a `k` c
-- flipC' (exl2 . h) :: b -> a `k` c

type Unit k = ()

type OkUnit k = Ok k (Unit k)

class OkUnit k => TerminalCat k where
  -- type Unit k :: u
  it :: Ok k a => a `k` Unit k
  default it :: (ConstCat k (Unit k), Ok k a) => a `k` Unit k
  it = () -> k a ()
forall a. Ok k a => () -> k a ()
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const ()
  {-# INLINE it #-}

-- TODO: add default it = const () when ConstCat k, and then remove instances
-- that were using this definition explicitly.

instance TerminalCat (->) where
  -- type Unit (->) = ()
  it :: forall a. Ok (->) a => a -> ()
it = () -> a -> ()
forall a. Ok (->) a => () -> a -> ()
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const ()

instance Monad m => TerminalCat (Kleisli m) where
  -- type Unit (Kleisli m) = ()
  it :: forall a. Ok (Kleisli m) a => Kleisli m a ()
it = (a -> ()) -> Kleisli m a ()
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> ()
forall a. Ok (->) a => a -> ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it

instance TerminalCat U2 where
  it :: forall a. Ok U2 a => U2 a ()
it = U2 a ()
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (TerminalCat k, TerminalCat k') => TerminalCat (k :**: k') where
  it :: forall a. Ok (k :**: k') a => (:**:) k k' a ()
it = k a ()
forall a. Ok k a => k a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it k a () -> k' a () -> (:**:) k k' a ()
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a ()
forall a. Ok k' a => k' a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it
  PINLINER(it)

class OkUnit k => UnitCat k where
  lunit :: Ok k a => a `k` Prod k (Unit k) a
  default lunit :: (MProductCat k, TerminalCat k, Ok k a) => a `k` Prod k (Unit k) a
  lunit = k a ()
forall a. Ok k a => k a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it k a () -> k a a -> k a (Prod k () a)
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id
  lcounit :: Ok k a => Prod k (Unit k) a `k` a
  default lcounit :: (ProductCat k, Ok k a) => Prod k (Unit k) a `k` a
  lcounit = k (Prod k () a) a
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr
  runit :: Ok k a => a `k` Prod k a (Unit k)
  default runit :: (MProductCat k, TerminalCat k, Ok k a) => a `k` Prod k a (Unit k)
  runit = k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id k a a -> k a () -> k a (Prod k a ())
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k a ()
forall a. Ok k a => k a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it
  rcounit :: Ok k a => Prod k a (Unit k) `k` a
  default rcounit :: (ProductCat k, TerminalCat k, Ok k a) => Prod k a (Unit k) `k` a
  rcounit = k (Prod k a ()) a
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl
  PINLINER(lunit)
  PINLINER(runit)
  PINLINER(lcounit)
  PINLINER(rcounit)

instance UnitCat (->)
instance Monad m => UnitCat (Kleisli m)
instance UnitCat U2

instance (UnitCat k, UnitCat k') => UnitCat (k :**: k') where
  lunit :: forall a. Ok (k :**: k') a => (:**:) k k' a (Prod (->) () a)
lunit   = k a (Prod k () a)
forall a. Ok k a => k a (Prod (->) () a)
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k a (Prod (->) () a)
lunit   k a (Prod k () a)
-> k' a (Prod k () a) -> (:**:) k k' a (Prod k () a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (Prod k () a)
forall a. Ok k' a => k' a (Prod (->) () a)
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k a (Prod (->) () a)
lunit
  runit :: forall a. Ok (k :**: k') a => (:**:) k k' a (Prod (->) a ())
runit   = k a (Prod k a ())
forall a. Ok k a => k a (Prod (->) a ())
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k a (Prod (->) a ())
runit   k a (Prod k a ())
-> k' a (Prod k a ()) -> (:**:) k k' a (Prod k a ())
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (Prod k a ())
forall a. Ok k' a => k' a (Prod (->) a ())
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k a (Prod (->) a ())
runit
  lcounit :: forall a. Ok (k :**: k') a => (:**:) k k' (Prod (->) () a) a
lcounit = k (Prod k () a) a
forall a. Ok k a => k (Prod (->) () a) a
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k (Prod (->) () a) a
lcounit k (Prod k () a) a
-> k' (Prod k () a) a -> (:**:) k k' (Prod k () a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k () a) a
forall a. Ok k' a => k' (Prod (->) () a) a
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k (Prod (->) () a) a
lcounit
  rcounit :: forall a. Ok (k :**: k') a => (:**:) k k' (Prod (->) a ()) a
rcounit = k (Prod k a ()) a
forall a. Ok k a => k (Prod (->) a ()) a
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k (Prod (->) a ()) a
rcounit k (Prod k a ()) a
-> k' (Prod k a ()) a -> (:**:) k k' (Prod k a ()) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod k a ()) a
forall a. Ok k' a => k' (Prod (->) a ()) a
forall (k :: Type -> Type -> Type) a.
(UnitCat k, Ok k a) =>
k (Prod (->) a ()) a
rcounit
  PINLINER(lunit)
  PINLINER(runit)
  PINLINER(lcounit)
  PINLINER(rcounit)

-- lunit :: (ProductCat k, TerminalCat k, Ok k a) => a `k` Prod k (Unit k) a
-- lunit = it &&& id

-- runit :: (ProductCat k, TerminalCat k, Ok k a) => a `k` Prod k a (Unit k)
-- runit = id &&& it

type Counit k = ()  -- for now

class Ok k (Counit k) => CoterminalCat k where
  ti :: Ok k a => Counit k `k` a

instance CoterminalCat U2 where
  ti :: forall a. Ok U2 a => U2 () a
ti = U2 () a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (CoterminalCat k, CoterminalCat k') => CoterminalCat (k :**: k') where
  ti :: forall a. Ok (k :**: k') a => (:**:) k k' () a
ti = k () a
forall a. Ok k a => k () a
forall (k :: Type -> Type -> Type) a.
(CoterminalCat k, Ok k a) =>
k () a
ti k () a -> k' () a -> (:**:) k k' () a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' () a
forall a. Ok k' a => k' () a
forall (k :: Type -> Type -> Type) a.
(CoterminalCat k, Ok k a) =>
k () a
ti
  PINLINER(ti)

#if 0

class Category k => UnsafeArr k where
  unsafeArr :: Ok2 k a b => (a -> b) -> a `k` b

instance UnsafeArr (->) where
  unsafeArr = A.arr

instance Monad m => UnsafeArr (Kleisli m) where
  unsafeArr = A.arr

#endif

constFun :: forall k p a b. (ClosedCat k, Ok3 k p a b)
         => (a `k` b) -> (p `k` Exp k a b)
constFun :: forall (k :: Type -> Type -> Type) p a b.
(ClosedCat k, Ok3 k p a b) =>
k a b -> k p (Exp k a b)
constFun k a b
f = k (p :* a) b -> k p (Exp k a b)
forall a b c.
Ok3 k a b c =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry (k a b
f k a b -> k (p :* a) a -> k (p :* a) b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (p :* a) a
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr) (Con (Sat (Ok k) (p :* a)) => k p (Exp k a b))
-> ((Sat (Ok k) p && Sat (Ok k) a) |- Sat (Ok k) (p :* a))
-> k p (Exp k a b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @p @a
{-# INLINE constFun #-}

--        f        :: a `k` b
--        f . exl  :: Prod k p a `k` b
-- curry (f . exl) :: p `k` (Exp k a b)

-- Combine with currying:

constFun2 :: forall k p a b c. (ClosedCat k, Oks k [p,a,b,c])
          => (Prod k a b `k` c) -> (p `k` (Exp k a (Exp k b c)))
constFun2 :: forall (k :: Type -> Type -> Type) p a b c.
(ClosedCat k, Oks k '[p, a, b, c]) =>
k (Prod k a b) c -> k p (Exp k a (Exp k b c))
constFun2 = k a (b -> c) -> k p (a -> (b -> c))
forall (k :: Type -> Type -> Type) p a b.
(ClosedCat k, Ok3 k p a b) =>
k a b -> k p (Exp k a b)
constFun (k a (b -> c) -> k p (a -> (b -> c)))
-> (k (a :* b) c -> k a (b -> c))
-> k (a :* b) c
-> k p (a -> (b -> c))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (a :* b) c -> k a (b -> c)
forall a b c.
Ok3 k a b c =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry
            (Con (Sat (Ok k) (b -> c)) => k (a :* b) c -> k p (a -> (b -> c)))
-> ((Sat (Ok k) b && Sat (Ok k) c) |- Sat (Ok k) (b -> c))
-> k (a :* b) c
-> k p (a -> (b -> c))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkExp k =>
(Ok' k a && Ok' k b) |- Ok' k (Exp k a b)
okExp @k @b @c

unitFun :: forall k a b. (ClosedCat k, TerminalCat k, Ok2 k a b)
        => (a `k` b) -> (Unit k `k` (Exp k a b))
unitFun :: forall (k :: Type -> Type -> Type) a b.
(ClosedCat k, TerminalCat k, Ok2 k a b) =>
k a b -> k () (Exp k a b)
unitFun = k a b -> k () (Exp k a b)
forall (k :: Type -> Type -> Type) p a b.
(ClosedCat k, Ok3 k p a b) =>
k a b -> k p (Exp k a b)
constFun

unUnitFun :: forall k p a. (ClosedCat k, MonoidalPCat k, TerminalCat k, Oks k [p,a]) =>
             (Unit k `k` Exp k p a) -> (p `k` a)
unUnitFun :: forall (k :: Type -> Type -> Type) p a.
(ClosedCat k, MonoidalPCat k, TerminalCat k, Oks k '[p, a]) =>
k () (Exp k p a) -> k p a
unUnitFun k () (Exp k p a)
g = k () (Exp k p a) -> k (() :* p) a
forall a b c. Ok3 k a b c => k a (Exp k b c) -> k (Prod k a b) c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry k () (Exp k p a)
g k (() :* p) a -> k p (() :* p) -> k p a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (k p ()
forall a. Ok k a => k a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it k p () -> k p p -> k p (() :* p)
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k p p
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id)
              (Con (Sat (Ok k) (() :* p)) => k p a)
-> ((Sat (Ok k) () && Sat (Ok k) p) |- Sat (Ok k) (() :* p))
-> k p a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @(Unit k) @p

{--------------------------------------------------------------------
    Constant arrows
--------------------------------------------------------------------}

-- Drop ConstObj for now

type ConstObj k b = b

#if 0

class (TerminalCat k, Ok k (ConstObj k b)) => ConstCat k b where
--   type ConstObj k b
--   type ConstObj k b = b
  unitArrow  :: b -> (Unit k `k` ConstObj k b)
  const :: Ok k a => b -> (a `k` ConstObj k b)
  const b = unitArrow b . it
  unitArrow = const
  {-# MINIMAL unitArrow | const #-}

#else

-- TODO: If I keep this version, remove TerminalCat parent
class (Category k, Ok k (ConstObj k b)) => ConstCat k b where
  -- type ConstObj k b
  -- type ConstObj k b = b
  const :: Ok k a => b -> (a `k` ConstObj k b)
  -- default const :: (HasRep (ConstObj k b), ConstCat k (Rep b), RepCat k, Ok k a)
  --               => b -> (a `k` ConstObj k b)
  -- const = repConst
  unitArrow :: OkUnit k => b -> (Unit k `k` ConstObj k b)
  unitArrow = b -> k () b
forall a. Ok k a => b -> k a b
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const
  -- default const :: (TerminalCat k, OkUnit k)
  --               => b -> (Unit k `k` ConstObj k b)
  default const :: (TerminalCat k, Ok k a)
                => b -> (a `k` ConstObj k b)
  const b
b = b -> k () b
forall (k :: Type -> Type -> Type) b.
(ConstCat k b, OkUnit k) =>
b -> k () b
unitArrow b
b k () b -> k a () -> k a b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a ()
forall a. Ok k a => k a ()
forall (k :: Type -> Type -> Type) a.
(TerminalCat k, Ok k a) =>
k a ()
it

#endif

#if 0

instance (ProductCat k, ConstCat k b, ConstCat k c, Ok k a)
      => ConstCat k (b :* c) where
  const = pairConst

instance {-# OVERLAPPABLE #-}
  ( Category k, ConstCat k (R.Rep b), RepCat k, HasRep (ConstObj k b)
  , Ok k (ConstObj k b) ) => ConstCat k b where
  const = repConst

#endif

repConst :: (HasRep b, r ~ R.Rep b, RepCat k b (ConstObj k r), ConstCat k r, Ok k a, Ok k (ConstObj k b))
         => b -> (a `k` ConstObj k b)
repConst :: forall b r (k :: Type -> Type -> Type) a.
(HasRep b, r ~ Rep b, RepCat k b r, ConstCat k r, Ok k a,
 Ok k b) =>
b -> k a b
repConst b
b = k r b
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k r a
abstC k r b -> k a r -> k a b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. r -> k a r
forall a. Ok k a => r -> k a r
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const (b -> Rep b
forall a. HasRep a => a -> Rep a
repr b
b)

--                      b  :: b
--                reprC b  :: r
--         const (reprC b) :: a `k` ConstObj k r
-- abstC . const (reprC b) :: a `k` ConstObj k r

pairConst :: (MProductCat k, ConstCat k b, ConstCat k c, Ok k a)
          => b :* c -> (a `k` (b :* c))
pairConst :: forall (k :: Type -> Type -> Type) b c a.
(MProductCat k, ConstCat k b, ConstCat k c, Ok k a) =>
(b :* c) -> k a (b :* c)
pairConst (b
b,c
c) = b -> k a b
forall a. Ok k a => b -> k a b
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const b
b k a b -> k a c -> k a (b, c)
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& c -> k a c
forall a. Ok k a => c -> k a c
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const c
c

-- | Inject a constant on the left
lconst :: forall k a b. (MProductCat k, ConstCat k a, Ok2 k a b)
       => a -> (b `k` (a :* b))
lconst :: forall (k :: Type -> Type -> Type) a b.
(MProductCat k, ConstCat k a, Ok2 k a b) =>
a -> k b (a :* b)
lconst a
a = k b a -> k (b :* b) (a :* b)
forall a a' b.
Ok3 k a b a' =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
forall (k :: Type -> Type -> Type) a a' b.
(MonoidalPCat k, Ok3 k a b a') =>
k a a' -> k (Prod (|-) a b) (Prod (|-) a' b)
first  (a -> k b a
forall a. Ok k a => a -> k a a
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const a
a) k (b :* b) (a :* b) -> k b (b :* b) -> k b (a :* b)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k b (b :* b)
forall a. Ok k a => k a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
           (Con (Sat (Ok k) (b :* b)) => k b (a :* b))
-> ((Sat (Ok k) b && Sat (Ok k) b) |- Sat (Ok k) (b :* b))
-> k b (a :* b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @b @b
           (Con (Sat (Ok k) (a :* b)) => k b (a :* b))
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :* b))
-> k b (a :* b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @(ConstObj k a) @b

-- | Inject a constant on the right
rconst :: forall k a b. (MProductCat k, ConstCat k b, Ok2 k a b)
       => b -> (a `k` (a :* b))
rconst :: forall (k :: Type -> Type -> Type) a b.
(MProductCat k, ConstCat k b, Ok2 k a b) =>
b -> k a (a :* b)
rconst b
b = k a b -> k (a :* a) (a :* b)
forall a b b'.
Ok3 k a b b' =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second (b -> k a b
forall a. Ok k a => b -> k a b
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const b
b) k (a :* a) (a :* b) -> k a (a :* a) -> k a (a :* b)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a (a :* a)
forall a. Ok k a => k a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
           (Con (Sat (Ok k) (a :* a)) => k a (a :* b))
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :* a))
-> k a (a :* b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
           (Con (Sat (Ok k) (a :* b)) => k a (a :* b))
-> ((Sat (Ok k) a && Sat (Ok k) b) |- Sat (Ok k) (a :* b))
-> k a (a :* b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @(ConstObj k b)

#if 1
instance ConstCat (->) b where const :: forall a. Ok (->) a => ConstObj (->) b -> a -> ConstObj (->) b
const = ConstObj (->) b -> a -> ConstObj (->) b
forall a b. a -> b -> a
P.const
#else

-- Temp cheat. No longer needed, since I fix transCatOp in Plugin to fail
-- gracefully when the target category doesn't inhabit the needed class.

#define LitConst(ty) \
instance ConstCat (->) (ty) where { const = P.const ; {-# INLINE const #-} }

LitConst(())
LitConst(Bool)
LitConst(Int)
LitConst(Float)
LitConst(Double)

#endif

-- instance Monad m => ConstCat (Kleisli m) b where const b = arr (const b)

instance (Monad m, ConstCat (->) b) => ConstCat (Kleisli m) b where const :: forall a.
Ok (Kleisli m) a =>
ConstObj (Kleisli m) b -> Kleisli m a (ConstObj (Kleisli m) b)
const ConstObj (Kleisli m) b
b = (a -> ConstObj (Kleisli m) b)
-> Kleisli m a (ConstObj (Kleisli m) b)
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (ConstObj (Kleisli m) b -> a -> ConstObj (Kleisli m) b
forall a.
Ok (->) a =>
ConstObj (Kleisli m) b -> a -> ConstObj (Kleisli m) b
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const ConstObj (Kleisli m) b
b)

-- For prims, use constFun instead.

instance ConstCat U2 a where
  const :: forall a. Ok U2 a => ConstObj U2 a -> U2 a (ConstObj U2 a)
const ConstObj U2 a
_ = U2 a (ConstObj U2 a)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  -- unitArrow b = unitArrow b :**: unitArrow b

instance (ConstCat k a, ConstCat k' a) => ConstCat (k :**: k') a where
  const :: forall a.
Ok (k :**: k') a =>
ConstObj (k :**: k') a -> (:**:) k k' a (ConstObj (k :**: k') a)
const ConstObj (k :**: k') a
b = ConstObj (k :**: k') a -> k a (ConstObj (k :**: k') a)
forall a.
Ok k a =>
ConstObj (k :**: k') a -> k a (ConstObj (k :**: k') a)
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const ConstObj (k :**: k') a
b k a (ConstObj (k :**: k') a)
-> k' a (ConstObj (k :**: k') a)
-> (:**:) k k' a (ConstObj (k :**: k') a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: ConstObj (k :**: k') a -> k' a (ConstObj (k :**: k') a)
forall a.
Ok k' a =>
ConstObj (k :**: k') a -> k' a (ConstObj (k :**: k') a)
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const ConstObj (k :**: k') a
b
  -- unitArrow b = unitArrow b :**: unitArrow b
  PINLINER(const)
  -- PINLINER(unitArrow)

-- Note that `ConstCat` is *not* poly-kinded. Since the codomain `b` is an
-- argument to `unitArrow` and `const`, `k :: * -> * -> *`. I'm uneasy
-- about this kind restriction, which would preclude some useful categories,
-- including linear maps and entailment. Revisit this issue later.

class DelayCat k where
  delay :: Ok k a => a -> (a `k` a)

instance DelayCat (->) where
  delay :: forall a. Ok (->) a => a -> a -> a
delay = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"delay: not really defined for functions"
  -- Will I need to use oops instead?

class ProductCat k => LoopCat k where
  loop :: Ok3 k s a b => ((a :* s) `k` (b :* s)) -> (a `k` b)

instance LoopCat (->) where
  loop :: forall s a b. Ok3 (->) s a b => ((a :* s) -> (b :* s)) -> a -> b
loop = String -> ((a :* s) -> (b :* s)) -> a -> b
forall a. HasCallStack => String -> a
error String
"loop: not really defined for functions"
  -- Will I need to use oops instead?

{--------------------------------------------------------------------
    Traced monoidal categories
--------------------------------------------------------------------}

class ProductCat k => TracedCat k where
  trace :: Ok3 k a b c => ((a :* c) `k` (b :* c)) -> (a `k` b)

instance TracedCat (->) where
  trace :: forall a b c. Ok3 (->) a b c => ((a :* c) -> (b :* c)) -> a -> b
trace (a :* c) -> (b :* c)
h a
a = b
b where (b
b,c
c) = (a :* c) -> (b :* c)
h (a
a,c
c)

instance TracedCat U2 where trace :: forall a b c. Ok3 U2 a b c => U2 (a :* c) (b :* c) -> U2 a b
trace U2 (a :* c) (b :* c)
U2 = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (TracedCat k, TracedCat k') => TracedCat (k :**: k') where
  trace :: forall a b c.
Ok3 (k :**: k') a b c =>
(:**:) k k' (a :* c) (b :* c) -> (:**:) k k' a b
trace (k (a :* c) (b :* c)
f :**: k' (a :* c) (b :* c)
g) = k (a :* c) (b :* c) -> k a b
forall a b c. Ok3 k a b c => k (a :* c) (b :* c) -> k a b
forall (k :: Type -> Type -> Type) a b c.
(TracedCat k, Ok3 k a b c) =>
k (a :* c) (b :* c) -> k a b
trace k (a :* c) (b :* c)
f k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (a :* c) (b :* c) -> k' a b
forall a b c. Ok3 k' a b c => k' (a :* c) (b :* c) -> k' a b
forall (k :: Type -> Type -> Type) a b c.
(TracedCat k, Ok3 k a b c) =>
k (a :* c) (b :* c) -> k a b
trace k' (a :* c) (b :* c)
g
  PINLINER(trace)

instance MonadFix m => TracedCat (Kleisli m) where
  trace :: forall a b c.
Ok3 (Kleisli m) a b c =>
Kleisli m (a :* c) (b :* c) -> Kleisli m a b
trace (Kleisli (a :* c) -> m (b :* c)
h) = (a -> m b) -> Kleisli m a b
forall (m :: Type -> Type) a b. (a -> m b) -> Kleisli m a b
Kleisli (\ a
a -> do rec (b
b,c
c) <- (a :* c) -> m (b :* c)
h (a
a,c
c)
                                         b -> m b
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b)
  PINLINER(trace)

{--------------------------------------------------------------------
    Class aggregates
--------------------------------------------------------------------}

-- | Bi-cartesion (cartesian & co-cartesian) closed categories. Also lumps in
-- terminal and distributive, though should probably be moved out.
type BiCCC k = (ClosedCat k, CoproductCat k, TerminalCat k, DistribCat k)

-- -- | 'BiCCC' with constant arrows.
-- type BiCCCC k p = (BiCCC k, ConstCat k p {-, RepCat k, LoopCat k, DelayCat k-})


{--------------------------------------------------------------------
    Add constraints to a category
--------------------------------------------------------------------}

-- infixr 3 &+&
-- class    (con a, con' a) => (con &+& con') a
-- instance (con a, con' a) => (con &+& con') a

-- instance (HasCon (f a), HasCon (g a)) => HasCon ((f &+& g) a) where
--   type Con ((f &+& g) a) = (Con (f a),Con (g a))
--   toDict (And1 (toDict -> Dict) (toDict -> Dict)) = Dict
--   unDict = And1 unDict unDict

data Constrained (con :: Type -> Constraint) k a b = Constrained (a `k` b)

instance (OpSat op con, OpSat op con') => OpCon op (Sat (con &+& con')) where
  inOp :: forall a b. Sat (con &+& con') a && Sat (con &+& con') b |- Sat (con &+& con') (a `op` b)
  inOp :: forall (a :: k) (b :: k).
(Sat (con &+& con') a && Sat (con &+& con') b)
|- Sat (con &+& con') (op a b)
inOp = (Con (Sat (con &+& con') a && Sat (con &+& con') b)
 :- Con (Sat (con &+& con') (op a b)))
-> (Sat (con &+& con') a && Sat (con &+& con') b)
   |- Sat (con &+& con') (op a b)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Con (Sat (con &+& con') a && Sat (con &+& con') b) =>
 Dict (Con (Sat (con &+& con') (op a b))))
-> Con (Sat (con &+& con') a && Sat (con &+& con') b)
   :- Con (Sat (con &+& con') (op a b))
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub ((Con (Sat (con &+& con') a && Sat (con &+& con') b) =>
  Dict (Con (Sat (con &+& con') (op a b))))
 -> Con (Sat (con &+& con') a && Sat (con &+& con') b)
    :- Con (Sat (con &+& con') (op a b)))
-> (Con (Sat (con &+& con') a && Sat (con &+& con') b) =>
    Dict (Con (Sat (con &+& con') (op a b))))
-> Con (Sat (con &+& con') a && Sat (con &+& con') b)
   :- Con (Sat (con &+& con') (op a b))
forall a b. (a -> b) -> a -> b
$ Dict ((&+&) con con' (op a b))
Con (Sat con (op a b)) => Dict ((&+&) con con' (op a b))
forall (a :: Constraint). a => Dict a
Dict (Con (Sat con (op a b)) => Dict ((&+&) con con' (op a b)))
-> ((Sat con a && Sat con b) |- Sat con (op a b))
-> Dict ((&+&) con con' (op a b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> Constraint) (a :: k)
       (b :: k).
OpCon op (Sat con) =>
(Sat con a && Sat con b) |- Sat con (op a b)
forall (op :: k -> k -> k) (con :: k -> Constraint) (a :: k)
       (b :: k).
OpCon op (Sat con) =>
(Sat con a && Sat con b) |- Sat con (op a b)
inSat @op @con @a @b (Con (Sat con' (op a b)) => Dict ((&+&) con con' (op a b)))
-> ((Sat con' a && Sat con' b) |- Sat con' (op a b))
-> Dict ((&+&) con con' (op a b))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall {k} (op :: k -> k -> k) (con :: k -> Constraint) (a :: k)
       (b :: k).
OpCon op (Sat con) =>
(Sat con a && Sat con b) |- Sat con (op a b)
forall (op :: k -> k -> k) (con :: k -> Constraint) (a :: k)
       (b :: k).
OpCon op (Sat con) =>
(Sat con a && Sat con b) |- Sat con (op a b)
inSat @op @con' @a @b)

-- TODO: define inSat, combining inOp and Sat

instance Category k => Category (Constrained con k) where
  type Ok (Constrained con k) = Ok k &+& con
  id :: forall a. Ok (Constrained con k) a => Constrained con k a a
id = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id
  Constrained k b c
g . :: forall b c a.
Ok3 (Constrained con k) a b c =>
Constrained con k b c
-> Constrained con k a b -> Constrained con k a c
. Constrained k a b
f = k a c -> Constrained con k a c
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k b c
g k b c -> k a b -> k a c
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a b
f)

instance (AssociativePCat k, OpSat (Prod k) con)
      => AssociativePCat (Constrained con k) where
  lassocP :: forall a b c.
Ok3 (Constrained con k) a b c =>
Constrained
  con k (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
lassocP = k (Prod (Constrained con k) a (Prod (Constrained con k) b c))
  (Prod (Constrained con k) (Prod (Constrained con k) a b) c)
-> Constrained
     con
     k
     (Prod (Constrained con k) a (Prod (Constrained con k) b c))
     (Prod (Constrained con k) (Prod (Constrained con k) a b) c)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a (Prod (Constrained con k) b c))
  (Prod (Constrained con k) (Prod (Constrained con k) a b) c)
forall a b c.
Ok3 k a b c =>
k (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
forall (k :: Type -> Type -> Type) a b c.
(AssociativePCat k, Ok3 k a b c) =>
k (Prod (|-) a (Prod (|-) b c)) (Prod (|-) (Prod (|-) a b) c)
lassocP
  rassocP :: forall a b c.
Ok3 (Constrained con k) a b c =>
Constrained
  con k (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
rassocP = k (Prod (Constrained con k) (Prod (Constrained con k) a b) c)
  (Prod (Constrained con k) a (Prod (Constrained con k) b c))
-> Constrained
     con
     k
     (Prod (Constrained con k) (Prod (Constrained con k) a b) c)
     (Prod (Constrained con k) a (Prod (Constrained con k) b c))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) (Prod (Constrained con k) a b) c)
  (Prod (Constrained con k) a (Prod (Constrained con k) b c))
forall a b c.
Ok3 k a b c =>
k (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
forall (k :: Type -> Type -> Type) a b c.
(AssociativePCat k, Ok3 k a b c) =>
k (Prod (|-) (Prod (|-) a b) c) (Prod (|-) a (Prod (|-) b c))
rassocP

instance (MonoidalPCat k, OpSat (Prod k) con)
      => MonoidalPCat (Constrained con k) where
  Constrained k a c
f *** :: forall a b c d.
Ok4 (Constrained con k) a b c d =>
Constrained con k a c
-> Constrained con k b d
-> Constrained con k (Prod (|-) a b) (Prod (|-) c d)
*** Constrained k b d
g = k (Prod (Constrained con k) a b) (Prod (Constrained con k) c d)
-> Constrained
     con k (Prod (Constrained con k) a b) (Prod (Constrained con k) c d)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k a c
f k a c
-> k b d
-> k (Prod (Constrained con k) a b) (Prod (Constrained con k) c d)
forall a b c d.
Ok4 k a b c d =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** k b d
g)

instance (BraidedPCat k, OpSat (Prod k) con) => BraidedPCat (Constrained con k) where
  swapP :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k (Prod (|-) a b) (Prod (|-) b a)
swapP = k (Prod (Constrained con k) a b) (Prod (Constrained con k) b a)
-> Constrained
     con k (Prod (Constrained con k) a b) (Prod (Constrained con k) b a)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a b) (Prod (Constrained con k) b a)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP

instance (ProductCat k, OpSat (Prod k) con) => ProductCat (Constrained con k) where
  -- type Prod (Constrained con k) = Prod k
  exl :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k (Prod (->) a b) a
exl = k (Prod (Constrained con k) a b) a
-> Constrained con k (Prod (Constrained con k) a b) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a b) a
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl
  exr :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k (Prod (->) a b) b
exr = k (Prod (Constrained con k) a b) b
-> Constrained con k (Prod (Constrained con k) a b) b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a b) b
forall a b. Ok2 k a b => k (Prod (->) a b) b
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) b
exr
  dup :: forall a.
Ok (Constrained con k) a =>
Constrained con k a (Prod (|-) a a)
dup = k a (Prod (Constrained con k) a a)
-> Constrained con k a (Prod (Constrained con k) a a)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a (Prod (Constrained con k) a a)
forall a. Ok k a => k a (Prod (|-) a a)
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup
  -- Constrained f &&& Constrained g = Constrained (f &&& g)

instance (AssociativeSCat k, OpSat (Coprod k) con)
      => AssociativeSCat (Constrained con k) where
  lassocS :: forall a b c.
Oks (Constrained con k) '[a, b, c] =>
Constrained
  con
  k
  (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
lassocS = k (Coprod (Constrained con k) a (Coprod (Constrained con k) b c))
  (Coprod (Constrained con k) (Coprod (Constrained con k) a b) c)
-> Constrained
     con
     k
     (Coprod (Constrained con k) a (Coprod (Constrained con k) b c))
     (Coprod (Constrained con k) (Coprod (Constrained con k) a b) c)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Coprod (Constrained con k) a (Coprod (Constrained con k) b c))
  (Coprod (Constrained con k) (Coprod (Constrained con k) a b) c)
forall a b c.
Oks k '[a, b, c] =>
k (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
forall (k :: Type -> Type -> Type) a b c.
(AssociativeSCat k, Oks k '[a, b, c]) =>
k (Coprod (->) a (Coprod (->) b c))
  (Coprod (->) (Coprod (->) a b) c)
lassocS
  rassocS :: forall a b c.
Oks (Constrained con k) '[a, b, c] =>
Constrained
  con
  k
  (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
rassocS = k (Coprod (Constrained con k) (Coprod (Constrained con k) a b) c)
  (Coprod (Constrained con k) a (Coprod (Constrained con k) b c))
-> Constrained
     con
     k
     (Coprod (Constrained con k) (Coprod (Constrained con k) a b) c)
     (Coprod (Constrained con k) a (Coprod (Constrained con k) b c))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Coprod (Constrained con k) (Coprod (Constrained con k) a b) c)
  (Coprod (Constrained con k) a (Coprod (Constrained con k) b c))
forall a b c.
Oks k '[a, b, c] =>
k (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
forall (k :: Type -> Type -> Type) a b c.
(AssociativeSCat k, Oks k '[a, b, c]) =>
k (Coprod (->) (Coprod (->) a b) c)
  (Coprod (->) a (Coprod (->) b c))
rassocS

instance (BraidedSCat k, OpSat (Coprod k) con)
      => BraidedSCat (Constrained con k) where
  swapS :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k (Coprod (->) a b) (Coprod (->) b a)
swapS = k (Coprod (Constrained con k) a b) (Coprod (Constrained con k) b a)
-> Constrained
     con
     k
     (Coprod (Constrained con k) a b)
     (Coprod (Constrained con k) b a)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Coprod (Constrained con k) a b) (Coprod (Constrained con k) b a)
forall a b. Ok2 k a b => k (Coprod (->) a b) (Coprod (->) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedSCat k, Ok2 k a b) =>
k (Coprod (->) a b) (Coprod (->) b a)
swapS

instance (MonoidalSCat k, OpSat (Coprod k) con)
      => MonoidalSCat (Constrained con k) where
  Constrained k c a
f +++ :: forall a b c d.
Ok4 (Constrained con k) a b c d =>
Constrained con k c a
-> Constrained con k d b
-> Constrained con k (Coprod k c d) (Coprod k a b)
+++ Constrained k d b
g = k (Coprod (Constrained con k) c d) (Coprod (Constrained con k) a b)
-> Constrained
     con
     k
     (Coprod (Constrained con k) c d)
     (Coprod (Constrained con k) a b)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k c a
f k c a
-> k d b
-> k (Coprod (Constrained con k) c d)
     (Coprod (Constrained con k) a b)
forall a b c d.
Ok4 k a b c d =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalSCat k, Ok4 k a b c d) =>
k c a -> k d b -> k (Coprod k c d) (Coprod k a b)
+++ k d b
g)

instance (CoproductCat k, OpSat (Coprod k) con)
      => CoproductCat (Constrained con k) where
  -- type Coprod (Constrained con k) = Coprod k
  inl :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k a (Coprod k a b)
inl = k a (Coprod (Constrained con k) a b)
-> Constrained con k a (Coprod (Constrained con k) a b)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a (Coprod (Constrained con k) a b)
forall a b. Ok2 k a b => k a (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k a (Coprod k a b)
inl
  inr :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k b (Coprod k a b)
inr = k b (Coprod (Constrained con k) a b)
-> Constrained con k b (Coprod (Constrained con k) a b)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k b (Coprod (Constrained con k) a b)
forall a b. Ok2 k a b => k b (Coprod k a b)
forall (k :: Type -> Type -> Type) a b.
(CoproductCat k, Ok2 k a b) =>
k b (Coprod k a b)
inr
  jam :: forall a.
Ok (Constrained con k) a =>
Constrained con k (Coprod k a a) a
jam = k (Coprod (Constrained con k) a a) a
-> Constrained con k (Coprod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Coprod (Constrained con k) a a) a
forall a. Ok k a => k (Coprod k a a) a
forall (k :: Type -> Type -> Type) a.
(CoproductCat k, Ok k a) =>
k (Coprod k a a) a
jam
  -- Constrained a ||| Constrained b = Constrained (a ||| b)

instance (ClosedCat k, OpSat (Prod k) con, OpSat (Exp k) con) => ClosedCat (Constrained con k) where
  -- type Exp (Constrained con k) = Exp k
  apply :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k (Prod k (Exp k a b) a) b
apply = k (Prod (Constrained con k) (Exp (Constrained con k) a b) a) b
-> Constrained
     con k (Prod (Constrained con k) (Exp (Constrained con k) a b) a) b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) (Exp (Constrained con k) a b) a) b
forall a b. Ok2 k a b => k (Prod k (Exp k a b) a) b
forall (k :: Type -> Type -> Type) a b.
(ClosedCat k, Ok2 k a b) =>
k (Prod k (Exp k a b) a) b
apply
  curry :: forall a b c.
Ok3 (Constrained con k) a b c =>
Constrained con k (Prod (->) a b) c
-> Constrained con k a (Exp (->) b c)
curry   (Constrained k (Prod (Constrained con k) a b) c
f) = k a (Exp (Constrained con k) b c)
-> Constrained con k a (Exp (Constrained con k) b c)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k (Prod (Constrained con k) a b) c
-> k a (Exp (Constrained con k) b c)
forall a b c.
Ok3 k a b c =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry k (Prod (Constrained con k) a b) c
f)
  uncurry :: forall a b c.
Ok3 (Constrained con k) a b c =>
Constrained con k a (Exp k b c) -> Constrained con k (Prod k a b) c
uncurry (Constrained k a (Exp (Constrained con k) b c)
g) = k (Prod (Constrained con k) a b) c
-> Constrained con k (Prod (Constrained con k) a b) c
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k a (Exp (Constrained con k) b c)
-> k (Prod (Constrained con k) a b) c
forall a b c. Ok3 k a b c => k a (Exp k b c) -> k (Prod k a b) c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry k a (Exp (Constrained con k) b c)
g)

instance (BoolCat k, con Bool, OpCon (Prod k) (Sat con))
      => BoolCat (Constrained con k) where
  notC :: Constrained
  con k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC = k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> Constrained
     con k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC
  andC :: Constrained
  con
  k
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
-> Constrained
     con
     k
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC
  orC :: Constrained
  con
  k
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
-> Constrained
     con
     k
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC
  xorC :: Constrained
  con
  k
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
-> Constrained
     con
     k
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC

instance (EqCat k a, con a, con Bool, OpSat (Prod k) con) => EqCat (Constrained con k) a where
  equal :: Constrained
  con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
equal = k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
-> Constrained
     con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
equal
  notEqual :: Constrained
  con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
notEqual = k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
-> Constrained
     con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
notEqual

instance (OrdCat k a, con a, con Bool, OpSat (Prod k) con) => OrdCat (Constrained con k) a where
  lessThan :: Constrained
  con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
lessThan = k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
-> Constrained
     con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThan
  greaterThan :: Constrained
  con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
greaterThan = k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
-> Constrained
     con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThan
  lessThanOrEqual :: Constrained
  con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
lessThanOrEqual = k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
-> Constrained
     con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThanOrEqual
  greaterThanOrEqual :: Constrained
  con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
greaterThanOrEqual = k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
-> Constrained
     con k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThanOrEqual

instance (CoerceCat k a b, con a, con b) => CoerceCat (Constrained con k) a b where
  coerceC :: Constrained con k a b
coerceC = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
CoerceCat k a b =>
k a b
coerceC

instance (ConstCat k b, con b) => ConstCat (Constrained con k) b where
  const :: forall a.
Ok (Constrained con k) a =>
ConstObj (Constrained con k) b
-> Constrained con k a (ConstObj (Constrained con k) b)
const = k a (ConstObj (Constrained con k) b)
-> Constrained con k a (ConstObj (Constrained con k) b)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k a (ConstObj (Constrained con k) b)
 -> Constrained con k a (ConstObj (Constrained con k) b))
-> (ConstObj (Constrained con k) b
    -> k a (ConstObj (Constrained con k) b))
-> ConstObj (Constrained con k) b
-> Constrained con k a (ConstObj (Constrained con k) b)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ConstObj (Constrained con k) b
-> k a (ConstObj (Constrained con k) b)
forall a.
Ok k a =>
ConstObj (Constrained con k) b
-> k a (ConstObj (Constrained con k) b)
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const

instance (TracedCat k, OpSat (Prod k) con) => TracedCat (Constrained con k) where
  trace :: forall a b c.
Ok3 (Constrained con k) a b c =>
Constrained con k (a :* c) (b :* c) -> Constrained con k a b
trace (Constrained k (a :* c) (b :* c)
fn) = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k a b -> Constrained con k a b) -> k a b -> Constrained con k a b
forall a b. (a -> b) -> a -> b
$ k (a :* c) (b :* c) -> k a b
forall a b c. Ok3 k a b c => k (a :* c) (b :* c) -> k a b
forall (k :: Type -> Type -> Type) a b c.
(TracedCat k, Ok3 k a b c) =>
k (a :* c) (b :* c) -> k a b
trace k (a :* c) (b :* c)
fn

instance OkFunctor (Constrained con k) f where
  okFunctor :: forall a.
Ok' (Constrained con k) a |- Ok' (Constrained con k) (f a)
okFunctor = forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkFunctor k h =>
Ok' k a |- Ok' k (h a)
okFunctor @(Constrained con k)

instance FunctorCat k f => FunctorCat (Constrained con k) f where
  fmapC :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k a b -> Constrained con k (f a) (f b)
fmapC (Constrained k a b
fn) = k (f a) (f b) -> Constrained con k (f a) (f b)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained (k (f a) (f b) -> Constrained con k (f a) (f b))
-> k (f a) (f b) -> Constrained con k (f a) (f b)
forall a b. (a -> b) -> a -> b
$ k a b -> k (f a) (f b)
forall a b. Ok2 k a b => k a b -> k (f a) (f b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(FunctorCat k h, Ok2 k a b) =>
k a b -> k (h a) (h b)
fmapC k a b
fn
  unzipC :: forall a b.
Ok2 (Constrained con k) a b =>
Constrained con k (f (a :* b)) (f a :* f b)
unzipC = k (f (a :* b)) (f a :* f b)
-> Constrained con k (f (a :* b)) (f a :* f b)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (f (a :* b)) (f a :* f b)
forall a b. Ok2 k a b => k (f (a :* b)) (f a :* f b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(FunctorCat k h, Ok2 k a b) =>
k (h (a :* b)) (h a :* h b)
unzipC

instance (Applicative m, con a) => PointedCat (Constrained con (->)) m a where
  pointC :: Constrained con (->) a (m a)
pointC = (a -> m a) -> Constrained con (->) a (m a)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

instance (NumCat k a, con a) => NumCat (Constrained con k) a where
  negateC :: Constrained con k a a
negateC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. NumCat k a => k a a
negateC
  addC :: Constrained con k (Prod (Constrained con k) a a) a
addC = k (Prod (Constrained con k) a a) a
-> Constrained con k (Prod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
addC
  subC :: Constrained con k (Prod (Constrained con k) a a) a
subC = k (Prod (Constrained con k) a a) a
-> Constrained con k (Prod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
subC
  mulC :: Constrained con k (Prod (Constrained con k) a a) a
mulC = k (Prod (Constrained con k) a a) a
-> Constrained con k (Prod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
mulC
  powIC :: Ok (Constrained con k) Int =>
Constrained con k (Prod (Constrained con k) a Int) a
powIC = k (Prod (Constrained con k) a Int) a
-> Constrained con k (Prod (Constrained con k) a Int) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a Int) a
forall (k :: Type -> Type -> Type) a.
(NumCat k a, Ok k Int) =>
k (Prod k a Int) a
powIC

instance (IntegralCat k a, con a) => IntegralCat (Constrained con k) a where
  divC :: Constrained con k (Prod (Constrained con k) a a) a
divC = k (Prod (Constrained con k) a a) a
-> Constrained con k (Prod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
divC
  modC :: Constrained con k (Prod (Constrained con k) a a) a
modC = k (Prod (Constrained con k) a a) a
-> Constrained con k (Prod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
modC

instance (FractionalCat k a, con a) => FractionalCat (Constrained con k) a where
  recipC :: Constrained con k a a
recipC  = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FractionalCat k a => k a a
recipC
  divideC :: Constrained con k (Prod (Constrained con k) a a) a
divideC = k (Prod (Constrained con k) a a) a
-> Constrained con k (Prod (Constrained con k) a a) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod (Constrained con k) a a) a
forall (k :: Type -> Type -> Type) a.
FractionalCat k a =>
k (Prod k a a) a
divideC

instance (FloatingCat k a, con a) => FloatingCat (Constrained con k) a where
  expC :: Constrained con k a a
expC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
expC
  logC :: Constrained con k a a
logC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
logC
  cosC :: Constrained con k a a
cosC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
cosC
  sinC :: Constrained con k a a
sinC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sinC
  sqrtC :: Constrained con k a a
sqrtC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sqrtC
  tanhC :: Constrained con k a a
tanhC = k a a -> Constrained con k a a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
tanhC

instance (RealFracCat k a b, con a, con b) => RealFracCat (Constrained con k) a b where
  floorC :: Constrained con k a b
floorC = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
floorC
  ceilingC :: Constrained con k a b
ceilingC = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
ceilingC
  truncateC :: Constrained con k a b
truncateC = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
truncateC

instance (FromIntegralCat k a b, con a, con b)
      => FromIntegralCat (Constrained con k) a b where
  fromIntegralC :: Constrained con k a b
fromIntegralC = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
FromIntegralCat k a b =>
k a b
fromIntegralC

instance (BottomCat k a b, con a, con b) => BottomCat (Constrained con k) a b where
  bottomC :: Constrained con k a b
bottomC = k a b -> Constrained con k a b
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
BottomCat k a b =>
k a b
bottomC

instance (IfCat k a, OpCon (Prod k) (Sat con), con Bool, con a)
      => IfCat (Constrained con k) a where
  ifC :: IfT (Constrained con k) a
ifC = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (Prod (Constrained con k) a a))
  a
-> IfT (Constrained con k) a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (Prod (Constrained con k) a a))
  a
forall (k :: Type -> Type -> Type) a. IfCat k a => IfT k a
ifC

instance (RepCat k a r, con a, con r) => RepCat (Constrained con k) a r where
  abstC :: Constrained con k r a
abstC = k r a -> Constrained con k r a
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k r a
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k r a
abstC
  reprC :: Constrained con k a r
reprC = k a r -> Constrained con k a r
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k a r
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k a r
reprC

instance RepresentableCat k f => RepresentableCat (Constrained con k) f where
  tabulateC :: forall a.
Ok (Constrained con k) a =>
Constrained con k (Rep f -> a) (f a)
tabulateC = k (Rep f -> a) (f a) -> Constrained con k (Rep f -> a) (f a)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (Rep f -> a) (f a)
forall a. Ok k a => k (Rep f -> a) (f a)
forall (k :: Type -> Type -> Type) (f :: Type -> Type) a.
(RepresentableCat k f, Ok k a) =>
k (Rep f -> a) (f a)
tabulateC
  indexC :: forall a.
Ok (Constrained con k) a =>
Constrained con k (f a) (Rep f -> a)
indexC = k (f a) (Rep f -> a) -> Constrained con k (f a) (Rep f -> a)
forall {k} {k} (con :: Type -> Constraint) (k :: k -> k -> Type)
       (a :: k) (b :: k).
k a b -> Constrained con k a b
Constrained k (f a) (Rep f -> a)
forall a. Ok k a => k (f a) (Rep f -> a)
forall (k :: Type -> Type -> Type) (f :: Type -> Type) a.
(RepresentableCat k f, Ok k a) =>
k (f a) (Rep f -> a)
indexC

{--------------------------------------------------------------------
    Other category subclasses, perhaps to move elsewhere
--------------------------------------------------------------------}

-- I don't think I want the general Kleisli instances for the rest.
-- For instance, for circuits, type BoolOf (:>) = Source Bool.

#define KleisliInstances

-- Adapted from Circat.Classes

type BoolOf k = Bool

class (ProductCat k, Ok k (BoolOf k)) => BoolCat k where
  -- type BoolOf k
  notC :: BoolOf k `k` BoolOf k
  andC, orC, xorC :: Prod k (BoolOf k) (BoolOf k) `k` BoolOf k

--     • Potential superclass cycle for ‘BoolCat’
--         one of whose superclass constraints is headed by a type family:
--           ‘Ok k bool’
--       Use UndecidableSuperClasses to accept this
--     • In the class declaration for ‘BoolCat’

instance BoolCat (->) where
  -- type BoolOf (->) = Bool
  notC :: BoolOf (Constrained con k) -> BoolOf (Constrained con k)
notC = BoolOf (Constrained con k) -> BoolOf (Constrained con k)
not
  andC :: Prod
  (Constrained con k)
  (BoolOf (Constrained con k))
  (BoolOf (Constrained con k))
-> BoolOf (Constrained con k)
andC = (BoolOf (Constrained con k)
 -> BoolOf (Constrained con k) -> BoolOf (Constrained con k))
-> Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k))
   -> BoolOf (Constrained con k)
forall a b c. (a -> b -> c) -> (a, b) -> c
P.uncurry BoolOf (Constrained con k)
-> BoolOf (Constrained con k) -> BoolOf (Constrained con k)
(&&)
  orC :: Prod
  (Constrained con k)
  (BoolOf (Constrained con k))
  (BoolOf (Constrained con k))
-> BoolOf (Constrained con k)
orC  = (BoolOf (Constrained con k)
 -> BoolOf (Constrained con k) -> BoolOf (Constrained con k))
-> Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k))
   -> BoolOf (Constrained con k)
forall a b c. (a -> b -> c) -> (a, b) -> c
P.uncurry BoolOf (Constrained con k)
-> BoolOf (Constrained con k) -> BoolOf (Constrained con k)
(||)
  xorC :: Prod
  (Constrained con k)
  (BoolOf (Constrained con k))
  (BoolOf (Constrained con k))
-> BoolOf (Constrained con k)
xorC = (BoolOf (Constrained con k)
 -> BoolOf (Constrained con k) -> BoolOf (Constrained con k))
-> Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k))
   -> BoolOf (Constrained con k)
forall a b c. (a -> b -> c) -> (a, b) -> c
P.uncurry BoolOf (Constrained con k)
-> BoolOf (Constrained con k) -> BoolOf (Constrained con k)
forall a. Eq a => a -> a -> BoolOf (Constrained con k)
(/=)

-- No inline, since not, (&&), (||) are not class-ops, and (/=) is
-- specialized to Bool here (and hence appears as $fEqBool_$c/=)

#ifdef KleisliInstances
instance Monad m => BoolCat (Kleisli m) where
  -- type BoolOf (Kleisli m) = Bool
  notC :: Kleisli m (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC = (BoolOf (Constrained con k) -> BoolOf (Constrained con k))
-> Kleisli
     m (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr BoolOf (Constrained con k) -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC
  andC :: Kleisli
  m
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC = (Prod
   (Constrained con k)
   (BoolOf (Constrained con k))
   (BoolOf (Constrained con k))
 -> BoolOf (Constrained con k))
-> Kleisli
     m
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod
  (Constrained con k)
  (BoolOf (Constrained con k))
  (BoolOf (Constrained con k))
-> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC
  orC :: Kleisli
  m
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC  = (Prod
   (Constrained con k)
   (BoolOf (Constrained con k))
   (BoolOf (Constrained con k))
 -> BoolOf (Constrained con k))
-> Kleisli
     m
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod
  (Constrained con k)
  (BoolOf (Constrained con k))
  (BoolOf (Constrained con k))
-> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC
  xorC :: Kleisli
  m
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC = (Prod
   (Constrained con k)
   (BoolOf (Constrained con k))
   (BoolOf (Constrained con k))
 -> BoolOf (Constrained con k))
-> Kleisli
     m
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod
  (Constrained con k)
  (BoolOf (Constrained con k))
  (BoolOf (Constrained con k))
-> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC
#endif

instance BoolCat U2 where
  notC :: U2 (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC = U2 (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  andC :: U2
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC = U2
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  orC :: U2
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC  = U2
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  xorC :: U2
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC = U2
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (BoolCat k, BoolCat k') => BoolCat (k :**: k') where
  notC :: (:**:)
  k k' (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC = k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> k' (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> (:**:)
     k k' (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC
  andC :: (:**:)
  k
  k'
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
-> k'
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
-> (:**:)
     k
     k'
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k'
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
andC
  orC :: (:**:)
  k
  k'
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC  = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC  k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
-> k'
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
-> (:**:)
     k
     k'
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k'
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
orC
  xorC :: (:**:)
  k
  k'
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC = k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
-> k'
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
-> (:**:)
     k
     k'
     (Prod
        (Constrained con k)
        (BoolOf (Constrained con k))
        (BoolOf (Constrained con k)))
     (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k'
  (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (Prod
     (Constrained con k)
     (BoolOf (Constrained con k))
     (BoolOf (Constrained con k)))
  (BoolOf (Constrained con k))
xorC
  PINLINER(notC)
  PINLINER(andC)
  PINLINER(orC)
  PINLINER(xorC)

okTT :: forall k a. OkProd k => Ok' k a |- Ok' k (Prod k a a)
okTT :: forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT = forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a (Prod (|-) (Sat (Ok k) a) (Sat (Ok k) a) |- Sat (Ok k) (a :* a))
-> (Sat (Ok k) a |- Prod (|-) (Sat (Ok k) a) (Sat (Ok k) a))
-> Sat (Ok k) a |- Sat (Ok k) (a :* a)
forall b c a. Ok3 (|-) a b c => (b |- c) -> (a |- b) -> a |- c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. Sat (Ok k) a |- Prod (|-) (Sat (Ok k) a) (Sat (Ok k) a)
forall a. Ok (|-) a => a |- Prod (|-) a a
forall (k :: Type -> Type -> Type) a.
(ProductCat k, Ok k a) =>
k a (Prod (|-) a a)
dup

class (BoolCat k, Ok k a) => EqCat k a where
  equal, notEqual :: Prod k a a `k` BoolOf k
  notEqual = k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
equal    (Con (Sat (Ok k) (Prod k a a)) =>
 k (Prod k a a) (BoolOf (Constrained con k)))
-> (Sat (Ok k) a |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT @k @a
  equal    = k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
notEqual (Con (Sat (Ok k) (Prod k a a)) =>
 k (Prod k a a) (BoolOf (Constrained con k)))
-> (Sat (Ok k) a |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT @k @a
  {-# MINIMAL equal | notEqual #-}

instance Eq a => EqCat (->) a where
  equal :: Prod (->) a a -> BoolOf (Constrained con k)
equal    = (a -> Exp (->) a (BoolOf (Constrained con k)))
-> Prod (->) a a -> BoolOf (Constrained con k)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a (BoolOf (Constrained con k)))
-> a -> Exp (->) a (BoolOf (Constrained con k))
forall a. a -> a
IC.inline a -> Exp (->) a (BoolOf (Constrained con k))
forall a. Eq a => a -> a -> BoolOf (Constrained con k)
(==))
  notEqual :: Prod (->) a a -> BoolOf (Constrained con k)
notEqual = (a -> Exp (->) a (BoolOf (Constrained con k)))
-> Prod (->) a a -> BoolOf (Constrained con k)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a (BoolOf (Constrained con k)))
-> a -> Exp (->) a (BoolOf (Constrained con k))
forall a. a -> a
IC.inline a -> Exp (->) a (BoolOf (Constrained con k))
forall a. Eq a => a -> a -> BoolOf (Constrained con k)
(/=))
  {-# OPINLINE equal #-}
  {-# OPINLINE notEqual #-}

#ifdef KleisliInstances
instance (Monad m, Eq a) => EqCat (Kleisli m) a where
  equal :: Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
equal    = (Prod (Kleisli m) a a -> BoolOf (Constrained con k))
-> Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
equal
  notEqual :: Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
notEqual = (Prod (Kleisli m) a a -> BoolOf (Constrained con k))
-> Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
notEqual
#endif

instance EqCat U2 a where
  equal :: U2 (Prod U2 a a) (BoolOf (Constrained con k))
equal = U2 (Prod U2 a a) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  notEqual :: U2 (Prod U2 a a) (BoolOf (Constrained con k))
notEqual = U2 (Prod U2 a a) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (EqCat k a, EqCat k' a) => EqCat (k :**: k') a where
  equal :: (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
equal = k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
equal k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
equal
  notEqual :: (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
notEqual = k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
notEqual k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
EqCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
notEqual
  PINLINER(equal)
  PINLINER(notEqual)

class (EqCat k a, Ord a) => OrdCat k a where
  lessThan, greaterThan, lessThanOrEqual, greaterThanOrEqual :: Prod k a a `k` BoolOf k
  default lessThan    :: BraidedPCat k => Prod k a a `k` BoolOf k
  default greaterThan :: BraidedPCat k => Prod k a a `k` BoolOf k
  greaterThan        = k (Prod k a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThan k (Prod k a a) (BoolOf (Constrained con k))
-> k (Prod k a a) (Prod k a a)
-> k (Prod k a a) (BoolOf (Constrained con k))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a a) (Prod k a a)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP    (Con (Sat (Ok k) (Prod k a a)) =>
 k (Prod k a a) (BoolOf (Constrained con k)))
-> (Sat (Ok k) a |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT @k @a
  lessThan           = k (Prod k a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThan k (Prod k a a) (BoolOf (Constrained con k))
-> k (Prod k a a) (Prod k a a)
-> k (Prod k a a) (BoolOf (Constrained con k))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a a) (Prod k a a)
forall a b. Ok2 k a b => k (Prod (|-) a b) (Prod (|-) b a)
forall (k :: Type -> Type -> Type) a b.
(BraidedPCat k, Ok2 k a b) =>
k (Prod (|-) a b) (Prod (|-) b a)
swapP (Con (Sat (Ok k) (Prod k a a)) =>
 k (Prod k a a) (BoolOf (Constrained con k)))
-> (Sat (Ok k) a |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT @k @a
  lessThanOrEqual    = k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThan  (Con (Sat (Ok k) (Prod k a a)) =>
 k (Prod k a a) (BoolOf (Constrained con k)))
-> (Sat (Ok k) a |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT @k @a
  greaterThanOrEqual = k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type).
BoolCat k =>
k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
notC k (BoolOf (Constrained con k)) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (Prod k a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThan     (Con (Sat (Ok k) (Prod k a a)) =>
 k (Prod k a a) (BoolOf (Constrained con k)))
-> (Sat (Ok k) a |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) (BoolOf (Constrained con k))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a.
OkProd k =>
Ok' k a |- Ok' k (Prod k a a)
okTT @k @a
  {-# MINIMAL lessThan | greaterThan #-}

class Ok k a => MinMaxCat k a where
  minC, maxC :: Prod k a a `k` a
#if 0
  default minC :: (OrdCat k a, IfCat k a, Ok k a) => Prod k a a `k` a
  default maxC :: (OrdCat k a, IfCat k a, Ok k a) => Prod k a a `k` a
  minC = ifC . (lessThanOrEqual &&& id)
           <+ okProd @k @Bool @(a :* a)
           <+ okProd @k @a @a
  maxC = ifC . (greaterThan     &&& id)
           <+ okProd @k @Bool @(a :* a)
           <+ okProd @k @a @a
#endif

-- TODO: maybe replace minC and maxC with sortP :: (a :* b) `k` (a :* b). Or add
-- a sortP method and defaults for all three. Would be groovy for parallel
-- sorting.

instance Ord a => MinMaxCat (->) a where
  minC :: Prod (->) a a -> a
minC = (a -> Exp (->) a a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a a) -> a -> Exp (->) a a
forall a. a -> a
IC.inline a -> Exp (->) a a
forall a. Ord a => a -> a -> a
min)
  maxC :: Prod (->) a a -> a
maxC = (a -> Exp (->) a a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a a) -> a -> Exp (->) a a
forall a. a -> a
IC.inline a -> Exp (->) a a
forall a. Ord a => a -> a -> a
max)
  {-# OPINLINE minC #-}
  {-# OPINLINE maxC #-}

instance Ord a => OrdCat (->) a where
  lessThan :: Prod (->) a a -> BoolOf (Constrained con k)
lessThan           = (a -> Exp (->) a (BoolOf (Constrained con k)))
-> Prod (->) a a -> BoolOf (Constrained con k)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a (BoolOf (Constrained con k)))
-> a -> Exp (->) a (BoolOf (Constrained con k))
forall a. a -> a
IC.inline a -> Exp (->) a (BoolOf (Constrained con k))
forall a. Ord a => a -> a -> BoolOf (Constrained con k)
(<))
  greaterThan :: Prod (->) a a -> BoolOf (Constrained con k)
greaterThan        = (a -> Exp (->) a (BoolOf (Constrained con k)))
-> Prod (->) a a -> BoolOf (Constrained con k)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a (BoolOf (Constrained con k)))
-> a -> Exp (->) a (BoolOf (Constrained con k))
forall a. a -> a
IC.inline a -> Exp (->) a (BoolOf (Constrained con k))
forall a. Ord a => a -> a -> BoolOf (Constrained con k)
(>))
  lessThanOrEqual :: Prod (->) a a -> BoolOf (Constrained con k)
lessThanOrEqual    = (a -> Exp (->) a (BoolOf (Constrained con k)))
-> Prod (->) a a -> BoolOf (Constrained con k)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a (BoolOf (Constrained con k)))
-> a -> Exp (->) a (BoolOf (Constrained con k))
forall a. a -> a
IC.inline a -> Exp (->) a (BoolOf (Constrained con k))
forall a. Ord a => a -> a -> BoolOf (Constrained con k)
(<=))
  greaterThanOrEqual :: Prod (->) a a -> BoolOf (Constrained con k)
greaterThanOrEqual = (a -> Exp (->) a (BoolOf (Constrained con k)))
-> Prod (->) a a -> BoolOf (Constrained con k)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a (BoolOf (Constrained con k)))
-> a -> Exp (->) a (BoolOf (Constrained con k))
forall a. a -> a
IC.inline a -> Exp (->) a (BoolOf (Constrained con k))
forall a. Ord a => a -> a -> BoolOf (Constrained con k)
(>=))
  {-# OPINLINE lessThan #-}
  {-# OPINLINE greaterThan #-}
  {-# OPINLINE lessThanOrEqual #-}
  {-# OPINLINE greaterThanOrEqual #-}

#ifdef KleisliInstances
instance (Monad m, Ord a) => OrdCat (Kleisli m) a where
  lessThan :: Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
lessThan           = (Prod (Kleisli m) a a -> BoolOf (Constrained con k))
-> Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThan
  greaterThan :: Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
greaterThan        = (Prod (Kleisli m) a a -> BoolOf (Constrained con k))
-> Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThan
  lessThanOrEqual :: Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
lessThanOrEqual    = (Prod (Kleisli m) a a -> BoolOf (Constrained con k))
-> Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThanOrEqual
  greaterThanOrEqual :: Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
greaterThanOrEqual = (Prod (Kleisli m) a a -> BoolOf (Constrained con k))
-> Kleisli m (Prod (Kleisli m) a a) (BoolOf (Constrained con k))
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> BoolOf (Constrained con k)
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThanOrEqual
#endif

instance Ord a => OrdCat U2 a where
  lessThan :: U2 (Prod U2 a a) (BoolOf (Constrained con k))
lessThan           = U2 (Prod U2 a a) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  greaterThan :: U2 (Prod U2 a a) (BoolOf (Constrained con k))
greaterThan        = U2 (Prod U2 a a) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  lessThanOrEqual :: U2 (Prod U2 a a) (BoolOf (Constrained con k))
lessThanOrEqual    = U2 (Prod U2 a a) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  greaterThanOrEqual :: U2 (Prod U2 a a) (BoolOf (Constrained con k))
greaterThanOrEqual = U2 (Prod U2 a a) (BoolOf (Constrained con k))
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance MinMaxCat U2 a where
  minC :: U2 (Prod U2 a a) a
minC = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  maxC :: U2 (Prod U2 a a) a
maxC = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (OrdCat k a, OrdCat k' a) => OrdCat (k :**: k') a where
  lessThan :: (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
lessThan = k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThan k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThan
  greaterThan :: (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
greaterThan = k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThan k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThan
  lessThanOrEqual :: (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
lessThanOrEqual = k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThanOrEqual k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
lessThanOrEqual
  greaterThanOrEqual :: (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
greaterThanOrEqual = k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThanOrEqual k (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
-> (:**:) k k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) (BoolOf (Constrained con k))
forall (k :: Type -> Type -> Type) a.
OrdCat k a =>
k (Prod k a a) (BoolOf (Constrained con k))
greaterThanOrEqual
  PINLINER(lessThan)
  PINLINER(greaterThan)
  PINLINER(lessThanOrEqual)
  PINLINER(greaterThanOrEqual)

instance (MinMaxCat k a, MinMaxCat k' a) => MinMaxCat (k :**: k') a where
  minC :: (:**:) k k' (Prod (k :**: k') a a) a
minC = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
MinMaxCat k a =>
k (Prod k a a) a
minC k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
MinMaxCat k a =>
k (Prod k a a) a
minC
  maxC :: (:**:) k k' (Prod (k :**: k') a a) a
maxC = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
MinMaxCat k a =>
k (Prod k a a) a
maxC k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
MinMaxCat k a =>
k (Prod k a a) a
maxC
  PINLINER(minC)
  PINLINER(maxC)

class (Category k, Ok k a) => EnumCat k a where
  succC, predC :: a `k` a
  default succC :: (MProductCat k, NumCat k a, ConstCat k a, Num a) => a `k` a
  default predC :: (MProductCat k, NumCat k a, ConstCat k a, Num a) => a `k` a
  succC = k (a :* a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
addC k (a :* a) a -> k a (a :* a) -> k a a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. a -> k a (a :* a)
forall (k :: Type -> Type -> Type) a b.
(MProductCat k, ConstCat k b, Ok2 k a b) =>
b -> k a (a :* b)
rconst a
1 (Con (Sat (Ok k) (a :* a)) => k a a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :* a)) -> k a a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
  predC = k (a :* a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
subC k (a :* a) a -> k a (a :* a) -> k a a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. a -> k a (a :* a)
forall (k :: Type -> Type -> Type) a b.
(MProductCat k, ConstCat k b, Ok2 k a b) =>
b -> k a (a :* b)
rconst a
1 (Con (Sat (Ok k) (a :* a)) => k a a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :* a)) -> k a a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a

instance Enum a => EnumCat (->) a where
  succC :: a -> a
succC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Enum a => a -> a
succ
  predC :: a -> a
predC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Enum a => a -> a
pred
  {-# OPINLINE succC #-}
  {-# OPINLINE predC #-}

instance EnumCat U2 a where
  succC :: U2 a a
succC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  predC :: U2 a a
predC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (EnumCat k a, EnumCat k' a) => EnumCat (k :**: k') a where
  succC :: (:**:) k k' a a
succC = k a a
forall (k :: Type -> Type -> Type) a. EnumCat k a => k a a
succC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. EnumCat k a => k a a
succC
  predC :: (:**:) k k' a a
predC = k a a
forall (k :: Type -> Type -> Type) a. EnumCat k a => k a a
predC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. EnumCat k a => k a a
predC
  PINLINER(succC)
  PINLINER(predC)

class Ok k a => NumCat k a where
  negateC :: a `k` a
  addC, subC, mulC :: Prod k a a `k` a
  powIC :: Ok k Int => Prod k a Int `k` a
  default subC :: MProductCat k => Prod k a a `k` a
  subC = k (Prod k a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
addC k (Prod k a a) a -> k (Prod k a a) (Prod k a a) -> k (Prod k a a) a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a a -> k (Prod k a a) (Prod k a a)
forall a b b'.
Ok3 k a b b' =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second k a a
forall (k :: Type -> Type -> Type) a. NumCat k a => k a a
negateC (Con (Sat (Ok k) (Prod k a a)) => k (Prod k a a) a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
  {-# INLINE subC #-}

instance Num a => NumCat (->) a where
  negateC :: a -> a
negateC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Num a => a -> a
negate
  -- mysterious bug workaround, but leads to different error. see 2017-12-27 notes.
  -- addC (x,y) = IC.inline (+) x y
  addC :: Prod (->) a a -> a
addC    = (a -> a -> a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> a -> a) -> a -> a -> a
forall a. a -> a
IC.inline a -> a -> a
forall a. Num a => a -> a -> a
(+))
  subC :: Prod (->) a a -> a
subC    = (a -> a -> a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> a -> a) -> a -> a -> a
forall a. a -> a
IC.inline (-))
  mulC :: Prod (->) a a -> a
mulC    = (a -> a -> a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> a -> a) -> a -> a -> a
forall a. a -> a
IC.inline a -> a -> a
forall a. Num a => a -> a -> a
(*))
  powIC :: Ok (->) Int => Prod (->) a Int -> a
powIC   = (a -> Exp (->) Int a) -> Prod (->) a Int -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry a -> Exp (->) Int a
forall a b. (Num a, Integral b) => a -> b -> a
(^) -- (^) is not a class-op
  {-# OPINLINE negateC #-}
  {-# OPINLINE addC #-}
  {-# OPINLINE subC #-}
  {-# OPINLINE mulC #-}
  {-# OPINLINE powIC #-}

#ifdef KleisliInstances
instance (Monad m, Num a) => NumCat (Kleisli m) a where
  negateC :: Kleisli m a a
negateC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. NumCat k a => k a a
negateC
  addC :: Kleisli m (Prod (Kleisli m) a a) a
addC    = (Prod (Kleisli m) a a -> a) -> Kleisli m (Prod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
addC
  subC :: Kleisli m (Prod (Kleisli m) a a) a
subC    = (Prod (Kleisli m) a a -> a) -> Kleisli m (Prod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
subC
  mulC :: Kleisli m (Prod (Kleisli m) a a) a
mulC    = (Prod (Kleisli m) a a -> a) -> Kleisli m (Prod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
mulC
  powIC :: Ok (Kleisli m) Int => Kleisli m (Prod (Kleisli m) a Int) a
powIC   = (Prod (Kleisli m) a Int -> a)
-> Kleisli m (Prod (Kleisli m) a Int) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a Int -> a
forall (k :: Type -> Type -> Type) a.
(NumCat k a, Ok k Int) =>
k (Prod k a Int) a
powIC
#endif

instance NumCat U2 a where
  negateC :: U2 a a
negateC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  addC :: U2 (Prod U2 a a) a
addC    = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  subC :: U2 (Prod U2 a a) a
subC    = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  mulC :: U2 (Prod U2 a a) a
mulC    = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  powIC :: Ok U2 Int => U2 (Prod U2 a Int) a
powIC   = U2 (Prod U2 a Int) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (NumCat k a, NumCat k' a) => NumCat (k :**: k') a where
  negateC :: (:**:) k k' a a
negateC = k a a
forall (k :: Type -> Type -> Type) a. NumCat k a => k a a
negateC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. NumCat k a => k a a
negateC
  addC :: (:**:) k k' (Prod (k :**: k') a a) a
addC    = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
addC    k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
addC
  subC :: (:**:) k k' (Prod (k :**: k') a a) a
subC    = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
subC    k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
subC
  mulC :: (:**:) k k' (Prod (k :**: k') a a) a
mulC    = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
mulC    k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
mulC
  powIC :: Ok (k :**: k') Int => (:**:) k k' (Prod (k :**: k') a Int) a
powIC   = k (Prod (k :**: k') a Int) a
forall (k :: Type -> Type -> Type) a.
(NumCat k a, Ok k Int) =>
k (Prod k a Int) a
powIC   k (Prod (k :**: k') a Int) a
-> k' (Prod (k :**: k') a Int) a
-> (:**:) k k' (Prod (k :**: k') a Int) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a Int) a
forall (k :: Type -> Type -> Type) a.
(NumCat k a, Ok k Int) =>
k (Prod k a Int) a
powIC
  PINLINER(negateC)
  PINLINER(addC)
  PINLINER(subC)
  PINLINER(mulC)
  PINLINER(powIC)

class Ok k a => IntegralCat k a where
  -- For now
  divC :: Prod k a a `k` a
  modC :: Prod k a a `k` a

divModC :: forall k a. (MProductCat k, IntegralCat k a, Ok k a)
        => Prod k a a `k` Prod k a a
divModC :: forall (k :: Type -> Type -> Type) a.
(MProductCat k, IntegralCat k a, Ok k a) =>
k (Prod k a a) (Prod k a a)
divModC = k (a :* a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
divC k (a :* a) a -> k (a :* a) a -> k (a :* a) (a :* a)
forall (k :: Type -> Type -> Type) a c d.
(MProductCat k, Ok3 k a c d) =>
k a c -> k a d -> k a (Prod k c d)
&&& k (a :* a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
modC  (Con (Sat (Ok k) (a :* a)) => k (a :* a) (a :* a))
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (a :* a))
-> k (a :* a) (a :* a)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a

instance Integral a => IntegralCat (->) a where
  divC :: Prod (->) a a -> a
divC = (a -> Exp (->) a a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a a) -> a -> Exp (->) a a
forall a. a -> a
IC.inline a -> Exp (->) a a
forall a. Integral a => a -> a -> a
div)
  modC :: Prod (->) a a -> a
modC = (a -> Exp (->) a a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> Exp (->) a a) -> a -> Exp (->) a a
forall a. a -> a
IC.inline a -> Exp (->) a a
forall a. Integral a => a -> a -> a
mod)
  {-# OPINLINE divC #-}
  {-# OPINLINE modC #-}

#ifdef KleisliInstances
instance (Monad m, Integral a) => IntegralCat (Kleisli m) a where
  divC :: Kleisli m (Prod (Kleisli m) a a) a
divC = (Prod (Kleisli m) a a -> a) -> Kleisli m (Prod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
divC
  modC :: Kleisli m (Prod (Kleisli m) a a) a
modC = (Prod (Kleisli m) a a -> a) -> Kleisli m (Prod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
modC
#endif

instance IntegralCat U2 a where
  divC :: U2 (Prod U2 a a) a
divC = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  modC :: U2 (Prod U2 a a) a
modC = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (IntegralCat k a, IntegralCat k' a) => IntegralCat (k :**: k') a where
  divC :: (:**:) k k' (Prod (k :**: k') a a) a
divC = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
divC k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
divC
  modC :: (:**:) k k' (Prod (k :**: k') a a) a
modC = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
modC k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
IntegralCat k a =>
k (Prod k a a) a
modC
  PINLINER(divC)
  PINLINER(modC)

class Ok k a => FractionalCat k a where
  recipC :: a `k` a
  divideC :: Prod k a a `k` a
  default recipC :: (MProductCat k, ConstCat k a, Num a) => a `k` a
  recipC = k (Prod k a a) a
forall (k :: Type -> Type -> Type) a.
FractionalCat k a =>
k (Prod k a a) a
divideC k (Prod k a a) a -> k a (Prod k a a) -> k a a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. a -> k a (Prod k a a)
forall (k :: Type -> Type -> Type) a b.
(MProductCat k, ConstCat k a, Ok2 k a b) =>
a -> k b (a :* b)
lconst a
1 (Con (Sat (Ok k) (Prod k a a)) => k a a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (Prod k a a))
-> k a a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
  {-# INLINE recipC #-}
  default divideC :: (MProductCat k, NumCat k a) => Prod k a a `k` a
  divideC = k (Prod k a a) a
forall (k :: Type -> Type -> Type) a.
NumCat k a =>
k (Prod k a a) a
mulC k (Prod k a a) a -> k (Prod k a a) (Prod k a a) -> k (Prod k a a) a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a a -> k (Prod k a a) (Prod k a a)
forall a b b'.
Ok3 k a b b' =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
forall (k :: Type -> Type -> Type) a b b'.
(MonoidalPCat k, Ok3 k a b b') =>
k b b' -> k (Prod (|-) a b) (Prod (|-) a b')
second k a a
forall (k :: Type -> Type -> Type) a. FractionalCat k a => k a a
recipC (Con (Sat (Ok k) (Prod k a a)) => k (Prod k a a) a)
-> ((Sat (Ok k) a && Sat (Ok k) a) |- Sat (Ok k) (Prod k a a))
-> k (Prod k a a) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @a
  {-# INLINE divideC #-}
  {-# MINIMAL recipC | divideC #-}

instance Fractional a => FractionalCat (->) a where
  recipC :: a -> a
recipC  = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Fractional a => a -> a
recip
  divideC :: Prod (->) a a -> a
divideC = (a -> a -> a) -> Prod (->) a a -> a
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((a -> a -> a) -> a -> a -> a
forall a. a -> a
IC.inline a -> a -> a
forall a. Fractional a => a -> a -> a
(/))
  {-# OPINLINE recipC #-}
  {-# OPINLINE divideC #-}

#ifdef KleisliInstances
instance (Monad m, Fractional a) => FractionalCat (Kleisli m) a where
  recipC :: Kleisli m a a
recipC  = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. FractionalCat k a => k a a
recipC
  divideC :: Kleisli m (Prod (Kleisli m) a a) a
divideC = (Prod (Kleisli m) a a -> a) -> Kleisli m (Prod (Kleisli m) a a) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod (Kleisli m) a a -> a
forall (k :: Type -> Type -> Type) a.
FractionalCat k a =>
k (Prod k a a) a
divideC
#endif

instance FractionalCat U2 a where
  recipC :: U2 a a
recipC  = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  divideC :: U2 (Prod U2 a a) a
divideC = U2 (Prod U2 a a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (FractionalCat k a, FractionalCat k' a) => FractionalCat (k :**: k') a where
  recipC :: (:**:) k k' a a
recipC  = k a a
forall (k :: Type -> Type -> Type) a. FractionalCat k a => k a a
recipC  k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FractionalCat k a => k a a
recipC
  divideC :: (:**:) k k' (Prod (k :**: k') a a) a
divideC = k (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
FractionalCat k a =>
k (Prod k a a) a
divideC k (Prod (k :**: k') a a) a
-> k' (Prod (k :**: k') a a) a
-> (:**:) k k' (Prod (k :**: k') a a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Prod (k :**: k') a a) a
forall (k :: Type -> Type -> Type) a.
FractionalCat k a =>
k (Prod k a a) a
divideC
  PINLINER(recipC)
  PINLINER(divideC)

class Ok k a => FloatingCat k a where
  expC, logC, cosC, sinC, sqrtC, tanhC :: a `k` a
  -- powC :: (a :* a) `k` a

-- ln :: Floating a => a -> a
-- ln = logBase (exp 1)

instance Floating a => FloatingCat (->) a where
  expC :: a -> a
expC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Floating a => a -> a
exp
  logC :: a -> a
logC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Floating a => a -> a
log
  cosC :: a -> a
cosC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Floating a => a -> a
cos
  sinC :: a -> a
sinC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Floating a => a -> a
sin
  sqrtC :: a -> a
sqrtC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Floating a => a -> a
sqrt
  tanhC :: a -> a
tanhC = (a -> a) -> a -> a
forall a. a -> a
IC.inline a -> a
forall a. Floating a => a -> a
tanh
  -- powC = IC.inline (**)
  {-# OPINLINE expC #-}
  {-# OPINLINE logC #-}
  {-# OPINLINE cosC #-}
  {-# OPINLINE sinC #-}
  {-# OPINLINE sqrtC #-}
  {-# OPINLINE tanhC #-}

#ifdef KleisliInstances
instance (Monad m, Floating a) => FloatingCat (Kleisli m) a where
  expC :: Kleisli m a a
expC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
expC
  logC :: Kleisli m a a
logC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
logC
  cosC :: Kleisli m a a
cosC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
cosC
  sinC :: Kleisli m a a
sinC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sinC
  sqrtC :: Kleisli m a a
sqrtC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sqrtC
  tanhC :: Kleisli m a a
tanhC = (a -> a) -> Kleisli m a a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> a
forall a. Floating a => a -> a
tanh
  -- powC = arr powC
#endif

instance FloatingCat U2 a where
  expC :: U2 a a
expC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  logC :: U2 a a
logC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  cosC :: U2 a a
cosC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  sinC :: U2 a a
sinC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  sqrtC :: U2 a a
sqrtC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  tanhC :: U2 a a
tanhC = U2 a a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  -- powC = U2

instance (FloatingCat k a, FloatingCat k' a) => FloatingCat (k :**: k') a where
  expC :: (:**:) k k' a a
expC = k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
expC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
expC
  logC :: (:**:) k k' a a
logC = k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
logC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
logC
  cosC :: (:**:) k k' a a
cosC = k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
cosC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
cosC
  sinC :: (:**:) k k' a a
sinC = k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sinC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sinC
  sqrtC :: (:**:) k k' a a
sqrtC = k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sqrtC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
sqrtC
  tanhC :: (:**:) k k' a a
tanhC = k a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
tanhC k a a -> k' a a -> (:**:) k k' a a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a a
forall (k :: Type -> Type -> Type) a. FloatingCat k a => k a a
tanhC
  PINLINER(expC)
  PINLINER(logC)
  PINLINER(cosC)
  PINLINER(sinC)
  PINLINER(sqrtC)
  PINLINER(tanhC)
  -- powC = powC :**: powC
  -- PINLINER(powC)

class Ok k a => RealFracCat k a b where
  floorC, ceilingC :: a `k` b
  truncateC :: a `k` b

instance (RealFrac a, Integral b) => RealFracCat (->) a b where
  floorC :: a -> b
floorC    = (a -> b) -> a -> b
forall a. a -> a
IC.inline a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor
  ceilingC :: a -> b
ceilingC  = (a -> b) -> a -> b
forall a. a -> a
IC.inline a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
  truncateC :: a -> b
truncateC = (a -> b) -> a -> b
forall a. a -> a
IC.inline a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate
  {-# OPINLINE floorC #-}
  {-# OPINLINE ceilingC #-}
  {-# OPINLINE truncateC #-}

#ifdef KleisliInstances
instance (Monad m, RealFrac a, Integral b) => RealFracCat (Kleisli m) a b where
  floorC :: Kleisli m a b
floorC    = (a -> b) -> Kleisli m a b
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
floorC
  ceilingC :: Kleisli m a b
ceilingC  = (a -> b) -> Kleisli m a b
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
ceilingC
  truncateC :: Kleisli m a b
truncateC = (a -> b) -> Kleisli m a b
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
truncateC
#endif

instance Integral b => RealFracCat U2 a b where
  floorC :: U2 a b
floorC    = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  ceilingC :: U2 a b
ceilingC  = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  truncateC :: U2 a b
truncateC = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (RealFracCat k a b, RealFracCat k' a b) => RealFracCat (k :**: k') a b where
  floorC :: (:**:) k k' a b
floorC    = k a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
floorC    k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
floorC
  ceilingC :: (:**:) k k' a b
ceilingC  = k a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
ceilingC  k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
ceilingC
  truncateC :: (:**:) k k' a b
truncateC = k a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
truncateC k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall (k :: Type -> Type -> Type) a b. RealFracCat k a b => k a b
truncateC
  PINLINER(floorC)
  PINLINER(ceilingC)
  PINLINER(truncateC)

-- Stand-in for fromIntegral, avoiding the intermediate Integer in the Prelude
-- definition.
class FromIntegralCat k a b where
  fromIntegralC :: a `k` b
  foo_FromIntegralCat :: ()  -- experiment
  foo_FromIntegralCat = ()

instance (Integral a, Num b) => FromIntegralCat (->) a b where
  fromIntegralC :: a -> b
fromIntegralC = (a -> b) -> a -> b
forall a. a -> a
X.inline a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral -- non-class-op
  {-# OPINLINE fromIntegralC #-}

#ifdef KleisliInstances
instance (Monad m, Integral a, Num b) => FromIntegralCat (Kleisli m) a b where
  fromIntegralC :: Kleisli m a b
fromIntegralC = (a -> b) -> Kleisli m a b
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#endif

instance FromIntegralCat U2 a b where
  fromIntegralC :: U2 a b
fromIntegralC = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (FromIntegralCat k a b, FromIntegralCat k' a b) => FromIntegralCat (k :**: k') a b where
  fromIntegralC :: (:**:) k k' a b
fromIntegralC = k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
FromIntegralCat k a b =>
k a b
fromIntegralC k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
FromIntegralCat k a b =>
k a b
fromIntegralC
  PINLINER(fromIntegralC)

#if 1

-- Revisit later. I used BottomCat for an encoding of sums via products.

class BottomCat k a b where
  bottomC :: a `k` b

-- instance (BottomCat k a b, BottomCat k a c, ProductCat k, Ok3 k a b c) => BottomCat k a (b :* c) where
--   bottomC = bottomC &&& bottomC

instance (BottomCat k a b, ClosedCat k, Ok4 k z b a (z -> b)) => BottomCat k a (z -> b) where
  bottomC :: k a (z -> b)
bottomC = k (a :* z) b -> k a (z -> b)
forall a b c.
Ok3 k a b c =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k (Prod (->) a b) c -> k a (Exp (->) b c)
curry (k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
BottomCat k a b =>
k a b
bottomC k a b -> k (a :* z) a -> k (a :* z) b
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k (a :* z) a
forall a b. Ok2 k a b => k (Prod (->) a b) a
forall (k :: Type -> Type -> Type) a b.
(ProductCat k, Ok2 k a b) =>
k (Prod (->) a b) a
exl) (Con (Sat (Ok k) (a :* z)) => k a (z -> b))
-> ((Sat (Ok k) a && Sat (Ok k) z) |- Sat (Ok k) (a :* z))
-> k a (z -> b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) a b.
OkProd k =>
(Ok' k a && Ok' k b) |- Ok' k (Prod k a b)
okProd @k @a @z

instance BottomCat (->) a b where bottomC :: a -> b
bottomC = String -> a -> b
forall a. HasCallStack => String -> a
error String
"bottomC for (->) evaluated"

instance BottomCat U2 a b where
  bottomC :: U2 a b
bottomC = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (BottomCat k a b, BottomCat k' a b) => BottomCat (k :**: k') a b where
  bottomC :: (:**:) k k' a b
bottomC = k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
BottomCat k a b =>
k a b
bottomC k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
BottomCat k a b =>
k a b
bottomC
  PINLINER(bottomC)

#endif

type IfT k a = Prod k (BoolOf k) (Prod k a a) `k` a

class (BoolCat k, Ok k a) => IfCat k a where
  ifC :: IfT k a

instance IfCat (->) a where
  ifC :: IfT (->) a
ifC (BoolOf (Constrained con k)
i,(a
t,a
e)) = if BoolOf (Constrained con k)
i then a
t else a
e

#ifdef KleisliInstances
instance Monad m => IfCat (Kleisli m) a where
  ifC :: IfT (Kleisli m) a
ifC = (Prod
   (Kleisli m) (BoolOf (Constrained con k)) (Prod (Kleisli m) a a)
 -> a)
-> IfT (Kleisli m) a
forall b c. (b -> c) -> Kleisli m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Prod
  (Kleisli m) (BoolOf (Constrained con k)) (Prod (Kleisli m) a a)
-> a
forall (k :: Type -> Type -> Type) a. IfCat k a => IfT k a
ifC
#endif

instance IfCat U2 a where
  ifC :: IfT U2 a
ifC = IfT U2 a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (IfCat k a, IfCat k' a) => IfCat (k :**: k') a where
  ifC :: IfT (k :**: k') a
ifC = IfT k a
forall (k :: Type -> Type -> Type) a. IfCat k a => IfT k a
ifC IfT k a
-> k'
     (Prod
        (k :**: k') (BoolOf (Constrained con k)) (Prod (k :**: k') a a))
     a
-> IfT (k :**: k') a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k'
  (Prod
     (k :**: k') (BoolOf (Constrained con k)) (Prod (k :**: k') a a))
  a
forall (k :: Type -> Type -> Type) a. IfCat k a => IfT k a
ifC
  PINLINER(ifC)

class UnknownCat k a b where
  unknownC :: a `k` b

instance UnknownCat (->) a b where
  unknownC :: a -> b
unknownC = String -> a -> b
forall a. HasCallStack => String -> a
error String
"unknown"

instance UnknownCat U2 a b where
  unknownC :: U2 a b
unknownC = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (UnknownCat k a b, UnknownCat k' a b) => UnknownCat (k :**: k') a b where
  unknownC :: (:**:) k k' a b
unknownC = k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
UnknownCat k a b =>
k a b
unknownC k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
UnknownCat k a b =>
k a b
unknownC
  PINLINER(unknownC)

class RepCat k a r where
  reprC :: a `k` r
  abstC :: r `k` a

-- 2018-02-08 (notes): I removed the "| a -> r" functional dependency.

instance (HasRep a, r ~ R.Rep a) => RepCat (->) a r where
  reprC :: a -> r
reprC = a -> r
a -> Rep a
forall a. HasRep a => a -> Rep a
repr
  abstC :: r -> a
abstC = r -> a
Rep a -> a
forall a. HasRep a => Rep a -> a
abst

instance (r ~ R.Rep a) => RepCat U2 a r where
  reprC :: U2 a r
reprC = U2 a r
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  abstC :: U2 r a
abstC = U2 r a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (RepCat k a b, RepCat k' a b) => RepCat (k :**: k') a b where
  reprC :: (:**:) k k' a b
reprC = k a b
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k a r
reprC k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k a r
reprC
  abstC :: (:**:) k k' b a
abstC = k b a
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k r a
abstC k b a -> k' b a -> (:**:) k k' b a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' b a
forall {k} (k :: k -> k -> Type) (a :: k) (r :: k).
RepCat k a r =>
k r a
abstC
  PINLINER(reprC)
  PINLINER(abstC)

class TransitiveCon con where
  trans :: (con a b, con b c) :- con a c

instance TransitiveCon Coercible where
  trans :: forall (a :: k) (b :: k) (c :: k).
(Coercible a b, Coercible b c) :- Coercible a c
trans = ((Coercible a b, Coercible b c) => Dict (Coercible a c))
-> (Coercible a b, Coercible b c) :- Coercible a c
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Coercible a c)
(Coercible a b, Coercible b c) => Dict (Coercible a c)
forall (a :: Constraint). a => Dict a
Dict

-- instance TransitiveCon (CoerceCat (->)) where
--   trans = Sub Dict

class (
      -- TransitiveCon (CoerceCat k)
      ) => CoerceCat k a b where
  coerceC :: a `k` b

instance Coercible a b => CoerceCat (->) a b where
  coerceC :: a -> b
coerceC = a -> b
forall a b. Coercible a b => a -> b
coerce

instance CoerceCat U2 a b where
  coerceC :: U2 a b
coerceC = U2 a b
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (CoerceCat k a b, CoerceCat k' a b) => CoerceCat (k :**: k') a b where
  coerceC :: (:**:) k k' a b
coerceC = k a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
CoerceCat k a b =>
k a b
coerceC k a b -> k' a b -> (:**:) k k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b
forall {k} {k} (k :: k -> k -> Type) (a :: k) (b :: k).
CoerceCat k a b =>
k a b
coerceC
  PINLINER(coerceC)

#if 0

#ifdef VectorSized
-- TODO: drop "Arr" alias if these definitions work out
type Arr = Vector

class (ClosedCat k, {-KnownNat n, -}Ok3 k b (Finite n) (Arr n b))
   => ArrayCat k n b where
  array :: Exp k (Finite n) b `k` Arr n b
  arrAt :: Prod k (Arr n b) (Finite n) `k` b

instance KnownNat n => ArrayCat (->) n b where
  array = arrayFun
  arrAt = arrAtFun
  PINLINER(array)
  PINLINER(arrAt)

arrayFun :: KnownNat n => (Finite n -> b) -> Arr n b
arrayFun = VS.generate_
{-# NOINLINE arrayFun #-}

arrAtFun :: KnownNat n => Arr n b :* Finite n -> b
arrAtFun = uncurry VS.index
{-# NOINLINE arrAtFun #-}

-- TODO: working definitions for arrayFun and arrAtFun

instance {- KnownNat n => -} ArrayCat U2 n b where
  array = U2
  arrAt = U2

instance (ArrayCat k n b, ArrayCat k' n b) => ArrayCat (k :**: k') n b where
  array = array :**: array
  arrAt = arrAt :**: arrAt
  PINLINER(array)
  PINLINER(arrAt)

-- #ifdef KleisliInstances
-- instance (Monad m, Enum n) => ArrayCat (Kleisli m) n b where
--   array = arr array
--   arrAt = arr arrAt
-- #endif

#else
-- Arrays
data Arr i a = MkArr (Array i a) deriving Show

-- I'm using "data" instead of "newtype" here to avoid the coercion.

class (ClosedCat k, Ok3 k a b (Arr a b)) => ArrayCat k a b where
  array :: Exp k a b `k` Arr a b
  arrAt :: Prod k (Arr a b) a `k` b
  -- at    :: Arr a b `k` Exp k a b
  -- {-# MINIMAL array, (arrAt | at) #-}
  -- arrAt = uncurry at
  -- at = curry arrAt

instance {- Enum a => -} ArrayCat (->) a b where
  array = arrayFun
  arrAt = arrAtFun
  PINLINER(array)
  PINLINER(arrAt)

arrayFun :: {- Enum a => -} (a -> b) -> Arr a b
arrayFun = oops "arrayFun not yet defined"
{-# NOINLINE arrayFun #-}

arrAtFun :: {- Enum a => -} Arr a b :* a -> b
arrAtFun = oops "arrAtFun not yet defined"
{-# NOINLINE arrAtFun #-}

-- TODO: working definitions for arrayFun and arrAtFun

instance ArrayCat U2 a b where
  array = U2
  -- array _ = U2
  arrAt = U2

instance (ArrayCat k a b, ArrayCat k' a b) => ArrayCat (k :**: k') a b where
  array = array :**: array
  arrAt = arrAt :**: arrAt
  PINLINER(array)
  PINLINER(arrAt)
  -- at = at :**: at
  -- PINLINER(at)

-- #ifdef KleisliInstances
-- instance (Monad m, Enum a) => ArrayCat (Kleisli m) a b where
--   array = arr array
--   arrAt = arr arrAt
-- #endif

#endif

#endif

{--------------------------------------------------------------------
    Functors
--------------------------------------------------------------------}

-- -- These functors change categories but not objects

-- -- | Functors map objects and arrows.
-- class (Category k, Category k'{-, OkTarget f k k'-})
--    => FunctorC f k k' {-  | f -> k k'-} where
--   -- | @fmapC@ maps arrows.
--   fmapC :: (Ok2 k a b, Oks k' [a,b]) => (a `k` b) -> (a `k'` b)
--   -- Laws:
--   -- fmapC id == id
--   -- fmapC (q . p) == fmapC q . fmapC p

{--------------------------------------------------------------------
    Functor-level operations
--------------------------------------------------------------------}

class OkFunctor k h where
  okFunctor :: Ok' k a |- Ok' k (h a)

instance OkFunctor (->) h where okFunctor :: forall a. Ok' (->) a |- Ok' (->) (h a)
okFunctor = (Con (Sat Yes1 a) :- Con (Sat Yes1 (h a)))
-> Sat Yes1 a |- Sat Yes1 (h a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Yes1 a => Dict (Yes1 (h a))) -> Yes1 a :- Yes1 (h a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Yes1 (h a))
Yes1 a => Dict (Yes1 (h a))
forall (a :: Constraint). a => Dict a
Dict)

instance (OkFunctor k h, OkFunctor k' h)
      => OkFunctor (k :**: k') h where
  okFunctor :: forall a. Ok' (k :**: k') a |- Ok' (k :**: k') (h a)
okFunctor = ((Sat (Ok k) a :* Sat (Ok k') a)
 |- (Sat (Ok k) (h a) :* Sat (Ok k') (h a)))
-> Sat (Ok k &+& Ok k') a |- Sat (Ok k &+& Ok k') (h a)
forall {k} {k} (con1 :: k -> Constraint) (a :: k)
       (con2 :: k -> Constraint) (con1' :: k -> Constraint) (b :: k)
       (con2' :: k -> Constraint).
((Sat con1 a :* Sat con2 a) |- (Sat con1' b :* Sat con2' b))
-> Sat (con1 &+& con2) a |- Sat (con1' &+& con2') b
inForkCon (forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkFunctor k h =>
Ok' k a |- Ok' k (h a)
okFunctor @k (Sat (Ok k) a |- Sat (Ok k) (h a))
-> (Sat (Ok k') a |- Sat (Ok k') (h a))
-> (Sat (Ok k) a :* Sat (Ok k') a)
   |- (Sat (Ok k) (h a) :* Sat (Ok k') (h a))
forall a b c d.
Ok4 (|-) a b c d =>
(a |- c) -> (b |- d) -> Prod (|-) a b |- Prod (|-) c d
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkFunctor k h =>
Ok' k a |- Ok' k (h a)
okFunctor @k')

class OkFunctor k h => FunctorCat k h where
  fmapC :: Ok2 k a b => (a `k` b) -> (h a `k` h b)
  unzipC :: forall a b. Ok2 k a b => h (a :* b) `k` (h a :* h b)
#if 0
  default unzipC :: forall a b.
          (FunctorCat k h, TerminalCat k, ClosedCat k, Ok2 k a b)
       => h (a :* b) `k` (h a :* h b)
  unzipC = fmapC exl &&& fmapC exr
             <+ okFunctor @k @h @(a :* b)
             <+ okFunctor @k @h @a
             <+ okFunctor @k @h @b
             <+ okProd    @k @a @b
#endif

-- TODO: Maybe rename FunctorCat to avoid confusion.

class (Zip h, OkFunctor k h) => ZipCat k h where
  zipC :: Ok2 k a b => (h a :* h b) `k` h (a :* b)
  -- zipWithC :: Ok3 k a b c => (a :* b -> c) `k` (h a :* h b -> h c)

class OkFunctor k h => ZapCat k h where
  zapC :: Ok2 k a b => h (a `k` b) -> (h a `k` h b)

class ({- Pointed h, -} OkFunctor k h, Ok k a) => PointedCat k h a where
  pointC :: a `k` h a

-- TODO: remove superclasses like Pointed from other classes, and then review
-- instances for unnecessary parent constraints. I've removed them the
-- PointedCat instances in Syntactic and Circuit.

-- TODO: eliminate pointC in favor of using tabulate

-- TODO: Try removing Representable h and maybe OkFunctor k h from the
-- superclasses.

-- TODO: Try removing OkFunctor superclass constraint.
-- When I first triec, I ran into trouble with a rule in AltCat.

-- class DiagCat k h where
--   diagC  :: Ok k a => (a :* a) `k` h (h a)

-- TODO: do I want SumCat, AddCat, or both?

-- class (Ok k a, Num a) => SumCat k h a where
--   sumC :: h a `k` a

class Ok k a => AddCat k h a where
  sumAC :: h a `k` a

-- class IxSummable n => IxSummableCat k n where
--   ixSumC ::  (Ok k a, Additive a) => (a :^ n) `k` a

-- TODO: Keep only one of AddCat and IxSummableCat, depending on whether I go
-- with functions or functors for indexed products and coproducts.
-- Nope. Use jamPF instead of ixSumC.

instance Functor h => FunctorCat (->) h where
  fmapC :: forall a b. Ok2 (->) a b => (a -> b) -> h a -> h b
fmapC  = ((a -> b) -> h a -> h b) -> (a -> b) -> h a -> h b
forall a. a -> a
IC.inline (a -> b) -> h a -> h b
forall a b. (a -> b) -> h a -> h b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
  unzipC :: forall a b. Ok2 (->) a b => h (a :* b) -> (h a :* h b)
unzipC = (h (a :* b) -> (h a :* h b)) -> h (a :* b) -> (h a :* h b)
forall a. a -> a
X.inline h (a :* b) -> (h a :* h b)
forall (f :: Type -> Type) a b.
Functor f =>
f (a :* b) -> f a :* f b
unzip
  {-# OPINLINE fmapC #-}
  {-# OPINLINE unzipC #-}

#if 0
instance (Zip h, Representable h) => ZipCat (->) h where
  zipC (as,bs) = tabulate (index as &&& index bs)
instance (Pointed h, Representable h) => PointedCat (->) h where
  pointC a = tabulate (const a)

-- Overlapping instances for ConCat.Misc.Yes1 (Rep h)
--   arising from a use of ‘&&&’
-- Matching instances:
--   instance [safe] forall k (a :: k). ConCat.Misc.Yes1 a
--     -- Defined at /Users/conal/Haskell/concat/classes/src/ConCat/Misc.hs:123:10
-- There exists a (perhaps superclass) match:
--   from the context: Representable h
--     bound by the instance declaration
--   or from: Ok2 (->) a b
--     bound by the type signature for:
--                zipC :: Ok2 (->) a b => h a :* h b -> h (a :* b)

-- TODO: inline for tabulate and index?

#else

instance Zip h => ZipCat (->) h where
  zipC :: forall a b. Ok2 (->) a b => (h a :* h b) -> h (a :* b)
zipC = (h a -> Exp (->) (h b) (h (a :* b))) -> (h a, h b) -> h (a :* b)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry ((h a -> Exp (->) (h b) (h (a :* b)))
-> h a -> Exp (->) (h b) (h (a :* b))
forall a. a -> a
IC.inline h a -> Exp (->) (h b) (h (a :* b))
forall a b. h a -> h b -> h (a, b)
forall (f :: Type -> Type) a b. Zip f => f a -> f b -> f (a, b)
zip)
  -- zipWithC :: (a :* b -> c) -> (h a :* h b -> h c)
  -- zipWithC f = uncurry (inline zipWith (curry f))
  {-# OPINLINE zipC #-}

instance Zip h => ZapCat (->) h where
  -- zapC = IC.inline zap
  -- zapC = zap
  zapC :: forall a b. Ok2 (->) a b => h (a -> b) -> h a -> h b
zapC = ((a -> b) -> a -> b) -> h (a -> b) -> h a -> h b
forall a b c. (a -> b -> c) -> h a -> h b -> h c
forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (a -> b) -> a -> b
forall a. Ok (->) a => a -> a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id  -- as in the default; 2017-12-27 notes
  {-# OPINLINE zapC #-}

instance Pointed h => PointedCat (->) h a where
  pointC :: a -> h a
pointC = (a -> h a) -> a -> h a
forall a. a -> a
IC.inline a -> h a
forall a. a -> h a
forall (p :: Type -> Type) a. Pointed p => a -> p a
point
  {-# OPINLINE pointC #-}

#endif

-- instance (Foldable h, Num a) => SumCat (->) h a where
--   sumC = IC.inline sum
--   {-# OPINLINE sumC #-}

instance (Foldable h, Additive a) => AddCat (->) h a where
  sumAC :: h a -> a
sumAC = h a -> a
forall (h :: Type -> Type) a. (Foldable h, Additive a) => h a -> a
sumA  -- not a method, so no IC.inline
  {-# OPINLINE sumAC #-}

-- instance (OkFunctor k h, OkFunctor k' h) => OkFunctor (k :**: k') h where
--   okFunctor = inForkCon (okFunctor @k *** okFunctor @k')

instance (FunctorCat k h, FunctorCat k' h) => FunctorCat (k :**: k') h where
  fmapC :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' a b -> (:**:) k k' (h a) (h b)
fmapC (k a b
f :**: k' a b
g) = k a b -> k (h a) (h b)
forall a b. Ok2 k a b => k a b -> k (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(FunctorCat k h, Ok2 k a b) =>
k a b -> k (h a) (h b)
fmapC k a b
f k (h a) (h b) -> k' (h a) (h b) -> (:**:) k k' (h a) (h b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a b -> k' (h a) (h b)
forall a b. Ok2 k' a b => k' a b -> k' (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(FunctorCat k h, Ok2 k a b) =>
k a b -> k (h a) (h b)
fmapC k' a b
g
  unzipC :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' (h (a :* b)) (h a :* h b)
unzipC = k (h (a :* b)) (h a :* h b)
forall a b. Ok2 k a b => k (h (a :* b)) (h a :* h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(FunctorCat k h, Ok2 k a b) =>
k (h (a :* b)) (h a :* h b)
unzipC k (h (a :* b)) (h a :* h b)
-> k' (h (a :* b)) (h a :* h b)
-> (:**:) k k' (h (a :* b)) (h a :* h b)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h (a :* b)) (h a :* h b)
forall a b. Ok2 k' a b => k' (h (a :* b)) (h a :* h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(FunctorCat k h, Ok2 k a b) =>
k (h (a :* b)) (h a :* h b)
unzipC
  {-# INLINE fmapC #-}
  {-# INLINE unzipC #-}

instance (ZipCat k h, ZipCat k' h) => ZipCat (k :**: k') h where
  zipC :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' (h a :* h b) (h (a :* b))
zipC = k (h a :* h b) (h (a :* b))
forall a b. Ok2 k a b => k (h a :* h b) (h (a :* b))
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(ZipCat k h, Ok2 k a b) =>
k (h a :* h b) (h (a :* b))
zipC k (h a :* h b) (h (a :* b))
-> k' (h a :* h b) (h (a :* b))
-> (:**:) k k' (h a :* h b) (h (a :* b))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a :* h b) (h (a :* b))
forall a b. Ok2 k' a b => k' (h a :* h b) (h (a :* b))
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(ZipCat k h, Ok2 k a b) =>
k (h a :* h b) (h (a :* b))
zipC
  {-# INLINE zipC #-}
  -- zipWithC = zipWithC :**: zipWithC
  -- {-# INLINE zipWithC #-}

instance (ZapCat k h, ZapCat k' h, Functor h) => ZapCat (k :**: k') h where
  zapC :: forall a b.
Ok2 (k :**: k') a b =>
h ((:**:) k k' a b) -> (:**:) k k' (h a) (h b)
zapC = (k (h a) (h b)
 -> Exp (->) (k' (h a) (h b)) ((:**:) k k' (h a) (h b)))
-> Prod (->) (k (h a) (h b)) (k' (h a) (h b))
-> (:**:) k k' (h a) (h b)
forall a b c. Ok3 (->) a b c => (a -> Exp k b c) -> Prod k a b -> c
forall (k :: Type -> Type -> Type) a b c.
(ClosedCat k, Ok3 k a b c) =>
k a (Exp k b c) -> k (Prod k a b) c
uncurry k (h a) (h b)
-> Exp (->) (k' (h a) (h b)) ((:**:) k k' (h a) (h b))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
(:**:) (Prod (->) (k (h a) (h b)) (k' (h a) (h b))
 -> (:**:) k k' (h a) (h b))
-> (h ((:**:) k k' a b)
    -> Prod (->) (k (h a) (h b)) (k' (h a) (h b)))
-> h ((:**:) k k' a b)
-> (:**:) k k' (h a) (h b)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (h (k a b) -> k (h a) (h b)
forall a b. Ok2 k a b => h (k a b) -> k (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(ZapCat k h, Ok2 k a b) =>
h (k a b) -> k (h a) (h b)
zapC (h (k a b) -> k (h a) (h b))
-> (h (k' a b) -> k' (h a) (h b))
-> Prod (->) (h (k a b)) (h (k' a b))
-> Prod (->) (k (h a) (h b)) (k' (h a) (h b))
forall a b c d.
Ok4 (->) a b c d =>
(a -> c) -> (b -> d) -> Prod (|-) a b -> Prod (|-) c d
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** h (k' a b) -> k' (h a) (h b)
forall a b. Ok2 k' a b => h (k' a b) -> k' (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(ZapCat k h, Ok2 k a b) =>
h (k a b) -> k (h a) (h b)
zapC) (Prod (->) (h (k a b)) (h (k' a b))
 -> Prod (->) (k (h a) (h b)) (k' (h a) (h b)))
-> (h ((:**:) k k' a b) -> Prod (->) (h (k a b)) (h (k' a b)))
-> h ((:**:) k k' a b)
-> Prod (->) (k (h a) (h b)) (k' (h a) (h b))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. h (k a b :* k' a b) -> Prod (->) (h (k a b)) (h (k' a b))
forall (f :: Type -> Type) a b.
Functor f =>
f (a :* b) -> f a :* f b
unzip (h (k a b :* k' a b) -> Prod (->) (h (k a b)) (h (k' a b)))
-> (h ((:**:) k k' a b) -> h (k a b :* k' a b))
-> h ((:**:) k k' a b)
-> Prod (->) (h (k a b)) (h (k' a b))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((:**:) k k' a b -> k a b :* k' a b)
-> h ((:**:) k k' a b) -> h (k a b :* k' a b)
forall a b. (a -> b) -> h a -> h b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (:**:) k k' a b -> k a b :* k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd
  {-# INLINE zapC #-}

--             unProd  :: (p :**: q) a b -> p a b :* q a b
--        fmap unProd  :: h ((p :**: q) a b) -> h (p a b :* q a b)
-- unzip (fmap unProd) :: h (p a b :* q a b) -> h (p a b) :* h (q a b)
-- (zapC *** zapC)     :: h (p a b) :* h (q a b) -> p (h a) (h b) :* q (h a) (h b)
-- uncurry (:**:)      :: p (h a) (h b) :* q (h a) (h b) -> (p :**: q) (h a) (h b)

instance (PointedCat k h a, PointedCat k' h a) => PointedCat (k :**: k') h a where
  pointC :: (:**:) k k' a (h a)
pointC = k a (h a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
PointedCat k h a =>
k a (h a)
pointC k a (h a) -> k' a (h a) -> (:**:) k k' a (h a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (h a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
PointedCat k h a =>
k a (h a)
pointC
  {-# INLINE pointC #-}

-- instance (DiagCat k h, DiagCat k' h) => DiagCat (k :**: k') h where
--   diagC  = diagC :**: diagC
--   {-# INLINE diagC #-}

-- instance (SumCat k h a, SumCat k' h a) => SumCat (k :**: k') h a where
--   sumC = sumC :**: sumC
--   {-# INLINE sumC #-}

instance (AddCat k h a, AddCat k' h a) => AddCat (k :**: k') h a where
  sumAC :: (:**:) k k' (h a) a
sumAC = k (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
AddCat k h a =>
k (h a) a
sumAC k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
AddCat k h a =>
k (h a) a
sumAC
  {-# INLINE sumAC #-}

-- instance (IxSummableCat k h a, IxSummableCat k' h a) => IxSummableCat (k :**: k') h a where
--   ixSumC = ixSumC :**: ixSumC
--   {-# INLINE ixSumC #-}

class TraversableCat k t f where
  sequenceAC :: Ok k a => t (f a) `k` f (t a)

-- TODO: perhaps remove the f parameter:
--
-- class TraversableCat k g where
--   sequenceAC :: (OkFunctor k f, Ok k a) => t (f a) `k` f (t a)

instance (Traversable t, Applicative f) => TraversableCat (->) t f where
  sequenceAC :: forall a. Ok (->) a => t (f a) -> f (t a)
sequenceAC = (t (f a) -> f (t a)) -> t (f a) -> f (t a)
forall a. a -> a
IC.inline t (f a) -> f (t a)
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: Type -> Type) a. Applicative f => t (f a) -> f (t a)
sequenceA
  {-# OPINLINE sequenceAC #-}

instance (TraversableCat k t f, TraversableCat k' t f)
      => TraversableCat (k :**: k') t f where
  sequenceAC :: forall a. Ok (k :**: k') a => (:**:) k k' (t (f a)) (f (t a))
sequenceAC = k (t (f a)) (f (t a))
forall a. Ok k a => k (t (f a)) (f (t a))
forall (k :: Type -> Type -> Type) (t :: Type -> Type)
       (f :: Type -> Type) a.
(TraversableCat k t f, Ok k a) =>
k (t (f a)) (f (t a))
sequenceAC k (t (f a)) (f (t a))
-> k' (t (f a)) (f (t a)) -> (:**:) k k' (t (f a)) (f (t a))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (t (f a)) (f (t a))
forall a. Ok k' a => k' (t (f a)) (f (t a))
forall (k :: Type -> Type -> Type) (t :: Type -> Type)
       (f :: Type -> Type) a.
(TraversableCat k t f, Ok k a) =>
k (t (f a)) (f (t a))
sequenceAC
  {-# INLINE sequenceAC #-}

class DistributiveCat k g f where
  distributeC :: Ok k a => f (g a) `k` g (f a)

-- TODO: perhaps remove the f parameter:
--
-- class DistributiveCat k g where
--   distributeC :: (OkFunctor k f, Ok k a) => f (g a) `k` g (f a)

instance (Distributive g, Functor f) => DistributiveCat (->) g f where
  distributeC :: forall a. Ok (->) a => f (g a) -> g (f a)
distributeC = (f (g a) -> g (f a)) -> f (g a) -> g (f a)
forall a. a -> a
IC.inline f (g a) -> g (f a)
forall (g :: Type -> Type) (f :: Type -> Type) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
forall (f :: Type -> Type) a. Functor f => f (g a) -> g (f a)
distribute
  {-# OPINLINE distributeC #-}

instance (DistributiveCat k g f, DistributiveCat k' g f)
      => DistributiveCat (k :**: k') g f where
  distributeC :: forall a. Ok (k :**: k') a => (:**:) k k' (f (g a)) (g (f a))
distributeC = k (f (g a)) (g (f a))
forall a. Ok k a => k (f (g a)) (g (f a))
forall (k :: Type -> Type -> Type) (g :: Type -> Type)
       (f :: Type -> Type) a.
(DistributiveCat k g f, Ok k a) =>
k (f (g a)) (g (f a))
distributeC k (f (g a)) (g (f a))
-> k' (f (g a)) (g (f a)) -> (:**:) k k' (f (g a)) (g (f a))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (f (g a)) (g (f a))
forall a. Ok k' a => k' (f (g a)) (g (f a))
forall (k :: Type -> Type -> Type) (g :: Type -> Type)
       (f :: Type -> Type) a.
(DistributiveCat k g f, Ok k a) =>
k (f (g a)) (g (f a))
distributeC
  {-# INLINE distributeC #-}

class RepresentableCat k f where
  tabulateC :: Ok k a => (Rep f -> a) `k` f a
  indexC    :: Ok k a => f a `k` (Rep f -> a)

instance Representable f => RepresentableCat (->) f where
  tabulateC :: forall a. Ok (->) a => (Rep f -> a) -> f a
tabulateC = ((Rep f -> a) -> f a) -> (Rep f -> a) -> f a
forall a. a -> a
IC.inline (Rep f -> a) -> f a
forall a. (Rep f -> a) -> f a
forall (f :: Type -> Type) a.
Representable f =>
(Rep f -> a) -> f a
tabulate
  indexC :: forall a. Ok (->) a => f a -> (Rep f -> a)
indexC    = (f a -> (Rep f -> a)) -> f a -> (Rep f -> a)
forall a. a -> a
IC.inline f a -> (Rep f -> a)
forall a. f a -> Rep f -> a
forall (f :: Type -> Type) a. Representable f => f a -> Rep f -> a
index
  {-# OPINLINE tabulateC #-}
  {-# OPINLINE indexC #-}

instance (RepresentableCat k h, RepresentableCat k' h)
      => RepresentableCat (k :**: k') h where
  tabulateC :: forall a. Ok (k :**: k') a => (:**:) k k' (Rep h -> a) (h a)
tabulateC = k (Rep h -> a) (h a)
forall a. Ok k a => k (Rep h -> a) (h a)
forall (k :: Type -> Type -> Type) (f :: Type -> Type) a.
(RepresentableCat k f, Ok k a) =>
k (Rep f -> a) (f a)
tabulateC k (Rep h -> a) (h a)
-> k' (Rep h -> a) (h a) -> (:**:) k k' (Rep h -> a) (h a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Rep h -> a) (h a)
forall a. Ok k' a => k' (Rep h -> a) (h a)
forall (k :: Type -> Type -> Type) (f :: Type -> Type) a.
(RepresentableCat k f, Ok k a) =>
k (Rep f -> a) (f a)
tabulateC
  indexC :: forall a. Ok (k :**: k') a => (:**:) k k' (h a) (Rep h -> a)
indexC    = k (h a) (Rep h -> a)
forall a. Ok k a => k (h a) (Rep h -> a)
forall (k :: Type -> Type -> Type) (f :: Type -> Type) a.
(RepresentableCat k f, Ok k a) =>
k (f a) (Rep f -> a)
indexC    k (h a) (Rep h -> a)
-> k' (h a) (Rep h -> a) -> (:**:) k k' (h a) (Rep h -> a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) (Rep h -> a)
forall a. Ok k' a => k' (h a) (Rep h -> a)
forall (k :: Type -> Type -> Type) (f :: Type -> Type) a.
(RepresentableCat k f, Ok k a) =>
k (f a) (Rep f -> a)
indexC
  {-# INLINE tabulateC #-}
  {-# INLINE indexC #-}

---- Experiment

-- fmap' and liftA2' are class-op-inlining synonyms for fmap and liftA2. Look
-- for a better alternative. See 2017-10-20 notes.

fmap' :: Functor f => (a -> b) -> f a -> f b
fmap' :: forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap' = ((a -> b) -> f a -> f b) -> (a -> b) -> f a -> f b
forall a. a -> a
IC.inline (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap

liftA2' :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
liftA2' :: forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2' a -> b -> c
f f a
as f b
bs = (a -> b -> c) -> f a -> f (b -> c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap' a -> b -> c
f f a
as f (b -> c) -> f b -> f c
forall a b. f (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f b
bs

-- dbanas 2018-01-08
zipWith' :: Zip f => (a -> b -> c) -> f a -> f b -> f c
zipWith' :: forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith' = ((a -> b -> c) -> f a -> f b -> f c)
-> (a -> b -> c) -> f a -> f b -> f c
forall a. a -> a
IC.inline (a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith

class FunctorCat k h => Strong k h where
  strength :: Ok2 k a b => (a :* h b) `k` h (a :* b)

instance Functor h => Strong (->) h where
  strength :: forall a b. Ok2 (->) a b => (a :* h b) -> h (a :* b)
strength (a
a,h b
bs) = (a
a,) (b -> a :* b) -> h b -> h (a :* b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> h b
bs

instance (Strong k h, Strong k' h) => Strong (k :**: k') h where
  strength :: forall a b.
Ok2 (k :**: k') a b =>
(:**:) k k' (a :* h b) (h (a :* b))
strength = k (a :* h b) (h (a :* b))
forall a b. Ok2 k a b => k (a :* h b) (h (a :* b))
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(Strong k h, Ok2 k a b) =>
k (a :* h b) (h (a :* b))
strength k (a :* h b) (h (a :* b))
-> k' (a :* h b) (h (a :* b))
-> (:**:) k k' (a :* h b) (h (a :* b))
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (a :* h b) (h (a :* b))
forall a b. Ok2 k' a b => k' (a :* h b) (h (a :* b))
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(Strong k h, Ok2 k a b) =>
k (a :* h b) (h (a :* b))
strength

{--------------------------------------------------------------------
    Indexed products and coproducts
--------------------------------------------------------------------}

-- I intend to replace all of the functor-level vocabulary with indexed products
-- and coproducts.

class OkIxProd k h where
  okIxProd :: Ok' k a |- Ok' k (h a)
-- TODO: Now same as OkFunctor, so drop one.

class (Category k, OkIxProd k h) => IxMonoidalPCat k h where
  crossF :: forall a b. Ok2 k a b => h (a `k` b) -> (h a `k` h b)

class IxMonoidalPCat k h => IxProductCat k h where
  exF    :: forall a  . Ok  k a   => h (h a `k` a)
  forkF  :: forall a b. Ok2 k a b => h (a `k` b) -> (a `k` h b)
  replF  :: forall a  . Ok  k a   => a `k` h a
  -- Defaults
  forkF h (k a b)
fs = h (k a b) -> k (h a) (h b)
forall a b. Ok2 k a b => h (k a b) -> k (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxMonoidalPCat k h, Ok2 k a b) =>
h (k a b) -> k (h a) (h b)
crossF h (k a b)
fs k (h a) (h b) -> k a (h a) -> k a (h b)
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. k a (h a)
forall a. Ok k a => k a (h a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxProductCat k h, Ok k a) =>
k a (h a)
replF (Con (Sat (Ok k) (h a)) => k a (h b))
-> (Sat (Ok k) a |- Sat (Ok k) (h a)) -> k a (h b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkIxProd k h =>
Ok' k a |- Ok' k (h a)
okIxProd @k @h @a (Con (Sat (Ok k) (h b)) => k a (h b))
-> (Sat (Ok k) b |- Sat (Ok k) (h b)) -> k a (h b)
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkIxProd k h =>
Ok' k a |- Ok' k (h a)
okIxProd @k @h @b
  default replF :: forall a . (Pointed h, Ok k a) => a `k` h a
  replF     = h (k a a) -> k a (h a)
forall a b. Ok2 k a b => h (k a b) -> k a (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxProductCat k h, Ok2 k a b) =>
h (k a b) -> k a (h b)
forkF (k a a -> h (k a a)
forall a. a -> h a
forall (p :: Type -> Type) a. Pointed p => a -> p a
point k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id)
  {-# INLINE forkF #-}
  {-# INLINE replF #-}
  {-# MINIMAL exF, (forkF | replF) #-}

  -- default crossF :: forall a b. (Zip h, Ok2 k a b) => h (a `k` b) -> (h a `k` h b)
  -- crossF fs = forkF (zipWith (.) fs exF) <+ okIxProd @k @h @a
  -- {-# INLINE crossF #-}

#if 0
-- Types for forkF

fs                :: h (a `k` b)
crossF fs         :: h a `k` h b
crossF fs . replF :: a `k` h b

-- Types for crossF

                      exF  :: h (h a `k` a)
                   fs      :: h (a `k` b)
       zipWith (.) fs exF  :: h (h a `k` b)
forkF (zipWith (.) fs exF) :: h a `k` h b

-- Types for `replF` via `forkF`:

       const id  :: h (a `k` a)
forkF (const id) :: a `k` h a

-- Laws:

forkF exF == id
(. forkF fs) <$> exF == fs

-- Types:

      exF :: h (h b `k` b)
forkF exF :: h b `k` h b

         fs          :: h (a `k` b)
   forkF fs          :: a `k` h b
(. forkF fs)         :: (h b `k` b) -> (a `k` b)
             <$> exF :: h (h b `k` b)
(. forkF fs) <$> exF :: h (a `k` b)

#endif

instance OkIxProd (->) h where okIxProd :: forall a. Ok' (->) a |- Ok' (->) (h a)
okIxProd = (Con (Sat Yes1 a) :- Con (Sat Yes1 (h a)))
-> Sat Yes1 a |- Sat Yes1 (h a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Yes1 a => Dict (Yes1 (h a))) -> Yes1 a :- Yes1 (h a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Yes1 (h a))
Yes1 a => Dict (Yes1 (h a))
forall (a :: Constraint). a => Dict a
Dict)

instance Zip h => IxMonoidalPCat (->) h where
  crossF :: forall a b. Ok2 (->) a b => h (a -> b) -> h a -> h b
crossF = ((a -> b) -> a -> b) -> h (a -> b) -> h a -> h b
forall a b c. (a -> b -> c) -> h a -> h b -> h c
forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (a -> b) -> a -> b
forall a. Ok (->) a => a -> a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id -- 2018-02-07 notes
  {-# INLINE crossF #-}

instance (Representable h, Zip h, Pointed h) => IxProductCat (->) h where
  exF :: forall a. Ok (->) a => h (h a -> a)
exF    = (Rep h -> h a -> a) -> h (h a -> a)
forall a. (Rep h -> a) -> h a
forall (f :: Type -> Type) a.
Representable f =>
(Rep f -> a) -> f a
tabulate ((h a -> Rep h -> a) -> Rep h -> h a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip h a -> Rep h -> a
forall a. h a -> Rep h -> a
forall (f :: Type -> Type) a. Representable f => f a -> Rep f -> a
index)
  replF :: forall a. Ok (->) a => a -> h a
replF  = a -> h a
forall a. a -> h a
forall (p :: Type -> Type) a. Pointed p => a -> p a
point
           -- zap
  forkF :: forall a b. Ok2 (->) a b => h (a -> b) -> a -> h b
forkF = \ h (a -> b)
fs a
x -> ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) ((a -> b) -> b) -> h (a -> b) -> h b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> h (a -> b)
fs
  {-# OPINLINE exF    #-}
  {-# OPINLINE replF  #-}
  {-# OPINLINE forkF #-}

--           flip index :: Rep h -> h a -> a
-- tabulate (flip index) :: h (h a -> a)
-- 
-- point :: a -> h a
-- zap   :: h (a -> b) -> h a -> h b

instance OkIxProd U2 h where
  okIxProd :: forall a. Ok' U2 a |- Ok' U2 (h a)
okIxProd = (Con (Sat Yes1 a) :- Con (Sat Yes1 (h a)))
-> Sat Yes1 a |- Sat Yes1 (h a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Yes1 a => Dict (Yes1 (h a))) -> Yes1 a :- Yes1 (h a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Yes1 (h a))
Yes1 a => Dict (Yes1 (h a))
forall (a :: Constraint). a => Dict a
Dict)

instance IxMonoidalPCat U2 h where
  crossF :: forall a b. Ok2 U2 a b => h (U2 a b) -> U2 (h a) (h b)
crossF = U2 (h a) (h b) -> h (U2 a b) -> U2 (h a) (h b)
forall a. Ok (->) a => U2 (h a) (h b) -> a -> U2 (h a) (h b)
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const U2 (h a) (h b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance Pointed h => IxProductCat U2 h where
  exF :: forall a. Ok U2 a => h (U2 (h a) a)
exF    = U2 (h a) a -> h (U2 (h a) a)
forall a. a -> h a
forall (p :: Type -> Type) a. Pointed p => a -> p a
point U2 (h a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  forkF :: forall a b. Ok2 U2 a b => h (U2 a b) -> U2 a (h b)
forkF  = U2 a (h b) -> h (U2 a b) -> U2 a (h b)
forall a. Ok (->) a => U2 a (h b) -> a -> U2 a (h b)
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const U2 a (h b)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  replF :: forall a. Ok U2 a => U2 a (h a)
replF  = U2 a (h a)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2

instance (OkIxProd k h, OkIxProd k' h) => OkIxProd (k :**: k') h where
  okIxProd :: forall a. Ok' (k :**: k') a |- Ok' (k :**: k') (h a)
  okIxProd :: forall a. Ok' (k :**: k') a |- Ok' (k :**: k') (h a)
okIxProd = (Con (Sat (Ok k &+& Ok k') a) :- Con (Sat (Ok k &+& Ok k') (h a)))
-> Sat (Ok k &+& Ok k') a |- Sat (Ok k &+& Ok k') (h a)
forall a b. (Con a :- Con b) -> a |- b
Entail (((&+&) (Ok k) (Ok k') a => Dict ((&+&) (Ok k) (Ok k') (h a)))
-> (&+&) (Ok k) (Ok k') a :- (&+&) (Ok k) (Ok k') (h a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub (Dict ((&+&) (Ok k) (Ok k') (h a))
Con (Sat (Ok k) (h a)) => Dict ((&+&) (Ok k) (Ok k') (h a))
forall (a :: Constraint). a => Dict a
Dict (Con (Sat (Ok k) (h a)) => Dict ((&+&) (Ok k) (Ok k') (h a)))
-> (Sat (Ok k) a |- Sat (Ok k) (h a))
-> Dict ((&+&) (Ok k) (Ok k') (h a))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkIxProd k h =>
Ok' k a |- Ok' k (h a)
okIxProd @k  @h @a
                               (Con (Sat (Ok k') (h a)) => Dict ((&+&) (Ok k) (Ok k') (h a)))
-> (Sat (Ok k') a |- Sat (Ok k') (h a))
-> Dict ((&+&) (Ok k) (Ok k') (h a))
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkIxProd k h =>
Ok' k a |- Ok' k (h a)
okIxProd @k' @h @a))

instance (IxMonoidalPCat k h, IxMonoidalPCat k' h, Zip h) => IxMonoidalPCat (k :**: k') h where
  crossF :: forall a b.
Ok2 (k :**: k') a b =>
h ((:**:) k k' a b) -> (:**:) k k' (h a) (h b)
crossF = Prod (->) (k (h a) (h b)) (k' (h a) (h b))
-> (:**:) k k' (h a) (h b)
forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k)
       (q :: k -> k -> Type).
(p a b :* q a b) -> (:**:) p q a b
prod (Prod (->) (k (h a) (h b)) (k' (h a) (h b))
 -> (:**:) k k' (h a) (h b))
-> (h ((:**:) k k' a b)
    -> Prod (->) (k (h a) (h b)) (k' (h a) (h b)))
-> h ((:**:) k k' a b)
-> (:**:) k k' (h a) (h b)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (h (k a b) -> k (h a) (h b)
forall a b. Ok2 k a b => h (k a b) -> k (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxMonoidalPCat k h, Ok2 k a b) =>
h (k a b) -> k (h a) (h b)
crossF (h (k a b) -> k (h a) (h b))
-> (h (k' a b) -> k' (h a) (h b))
-> Prod (->) (h (k a b)) (h (k' a b))
-> Prod (->) (k (h a) (h b)) (k' (h a) (h b))
forall a b c d.
Ok4 (->) a b c d =>
(a -> c) -> (b -> d) -> Prod (|-) a b -> Prod (|-) c d
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** h (k' a b) -> k' (h a) (h b)
forall a b. Ok2 k' a b => h (k' a b) -> k' (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxMonoidalPCat k h, Ok2 k a b) =>
h (k a b) -> k (h a) (h b)
crossF) (Prod (->) (h (k a b)) (h (k' a b))
 -> Prod (->) (k (h a) (h b)) (k' (h a) (h b)))
-> (h ((:**:) k k' a b) -> Prod (->) (h (k a b)) (h (k' a b)))
-> h ((:**:) k k' a b)
-> Prod (->) (k (h a) (h b)) (k' (h a) (h b))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. h (k a b :* k' a b) -> Prod (->) (h (k a b)) (h (k' a b))
forall (f :: Type -> Type) a b.
Functor f =>
f (a :* b) -> f a :* f b
unzip (h (k a b :* k' a b) -> Prod (->) (h (k a b)) (h (k' a b)))
-> (h ((:**:) k k' a b) -> h (k a b :* k' a b))
-> h ((:**:) k k' a b)
-> Prod (->) (h (k a b)) (h (k' a b))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((:**:) k k' a b -> k a b :* k' a b)
-> h ((:**:) k k' a b) -> h (k a b :* k' a b)
forall a b. (a -> b) -> h a -> h b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (:**:) k k' a b -> k a b :* k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd

instance (IxProductCat k h, IxProductCat k' h, Zip h) => IxProductCat (k :**: k') h where
  exF :: forall a. Ok (k :**: k') a => h ((:**:) k k' (h a) a)
exF    = (k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a)
-> h (k (h a) a) -> h (k' (h a) a) -> h ((:**:) k k' (h a) a)
forall a b c. (a -> b -> c) -> h a -> h b -> h c
forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
(:**:) h (k (h a) a)
forall a. Ok k a => h (k (h a) a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxProductCat k h, Ok k a) =>
h (k (h a) a)
exF h (k' (h a) a)
forall a. Ok k' a => h (k' (h a) a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxProductCat k h, Ok k a) =>
h (k (h a) a)
exF
  forkF :: forall a b.
Ok2 (k :**: k') a b =>
h ((:**:) k k' a b) -> (:**:) k k' a (h b)
forkF  = Prod (->) (k a (h b)) (k' a (h b)) -> (:**:) k k' a (h b)
forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k)
       (q :: k -> k -> Type).
(p a b :* q a b) -> (:**:) p q a b
prod (Prod (->) (k a (h b)) (k' a (h b)) -> (:**:) k k' a (h b))
-> (h ((:**:) k k' a b) -> Prod (->) (k a (h b)) (k' a (h b)))
-> h ((:**:) k k' a b)
-> (:**:) k k' a (h b)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (h (k a b) -> k a (h b)
forall a b. Ok2 k a b => h (k a b) -> k a (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxProductCat k h, Ok2 k a b) =>
h (k a b) -> k a (h b)
forkF  (h (k a b) -> k a (h b))
-> (h (k' a b) -> k' a (h b))
-> Prod (->) (h (k a b)) (h (k' a b))
-> Prod (->) (k a (h b)) (k' a (h b))
forall a b c d.
Ok4 (->) a b c d =>
(a -> c) -> (b -> d) -> Prod (|-) a b -> Prod (|-) c d
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** h (k' a b) -> k' a (h b)
forall a b. Ok2 k' a b => h (k' a b) -> k' a (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxProductCat k h, Ok2 k a b) =>
h (k a b) -> k a (h b)
forkF ) (Prod (->) (h (k a b)) (h (k' a b))
 -> Prod (->) (k a (h b)) (k' a (h b)))
-> (h ((:**:) k k' a b) -> Prod (->) (h (k a b)) (h (k' a b)))
-> h ((:**:) k k' a b)
-> Prod (->) (k a (h b)) (k' a (h b))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. h (k a b :* k' a b) -> Prod (->) (h (k a b)) (h (k' a b))
forall (f :: Type -> Type) a b.
Functor f =>
f (a :* b) -> f a :* f b
unzip (h (k a b :* k' a b) -> Prod (->) (h (k a b)) (h (k' a b)))
-> (h ((:**:) k k' a b) -> h (k a b :* k' a b))
-> h ((:**:) k k' a b)
-> Prod (->) (h (k a b)) (h (k' a b))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((:**:) k k' a b -> k a b :* k' a b)
-> h ((:**:) k k' a b) -> h (k a b :* k' a b)
forall a b. (a -> b) -> h a -> h b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (:**:) k k' a b -> k a b :* k' a b
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd
  replF :: forall a. Ok (k :**: k') a => (:**:) k k' a (h a)
replF  = k a (h a)
forall a. Ok k a => k a (h a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxProductCat k h, Ok k a) =>
k a (h a)
replF k a (h a) -> k' a (h a) -> (:**:) k k' a (h a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' a (h a)
forall a. Ok k' a => k' a (h a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxProductCat k h, Ok k a) =>
k a (h a)
replF

class (OkFunctor k h, Ok k a) => MinMaxFunctorCat k h a where
  minimumC :: h a `k` a
  maximumC :: h a `k` a

instance (MinMaxFunctorCat k h a, MinMaxFunctorCat k' h a) => MinMaxFunctorCat (k :**: k') h a where
  minimumC :: (:**:) k k' (h a) a
minimumC = k (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFunctorCat k h a =>
k (h a) a
minimumC k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFunctorCat k h a =>
k (h a) a
minimumC
  maximumC :: (:**:) k k' (h a) a
maximumC = k (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFunctorCat k h a =>
k (h a) a
maximumC k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFunctorCat k h a =>
k (h a) a
maximumC
  
instance MinMax h a => MinMaxFunctorCat (->) h a where
  minimumC :: h a -> a
minimumC = h a -> a
forall (h :: Type -> Type) a. MinMax h a => h a -> a
minimum
  maximumC :: h a -> a
maximumC = h a -> a
forall (h :: Type -> Type) a. MinMax h a => h a -> a
maximum
  {-# OPINLINE minimumC #-}
  {-# OPINLINE maximumC #-}

-- needed to construct the typeclass hierarchy for MinMaxFunctorCat
class (OkFunctor k h, Ok k a) => MinMaxFFunctorCat k h a where
  minimumCF :: h a -> (a :* (h a `k` a))
  maximumCF :: h a -> (a :* (h a `k` a))

instance MinMaxRep h a => MinMaxFFunctorCat (->) h a where
  minimumCF :: h a -> a :* (h a -> a)
minimumCF h a
h =
    let (Rep h
i, a
v) = h a -> (Rep h, a)
forall (f :: Type -> Type) a. MinMaxRep f a => f a -> (Rep f, a)
minimumRep h a
h
    in (a
v, (h a -> Rep h -> a) -> Rep h -> h a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip h a -> Rep h -> a
forall a. h a -> Rep h -> a
forall (f :: Type -> Type) a. Representable f => f a -> Rep f -> a
index Rep h
i)

  maximumCF :: h a -> a :* (h a -> a)
maximumCF h a
h =
    let (Rep h
i, a
v) = h a -> (Rep h, a)
forall (f :: Type -> Type) a. MinMaxRep f a => f a -> (Rep f, a)
maximumRep h a
h
    in (a
v, (h a -> Rep h -> a) -> Rep h -> h a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip h a -> Rep h -> a
forall a. h a -> Rep h -> a
forall (f :: Type -> Type) a. Representable f => f a -> Rep f -> a
index Rep h
i)
  {-# OPINLINE minimumCF #-}
  {-# OPINLINE maximumCF #-}

instance (MinMaxFFunctorCat k h a, MinMaxFFunctorCat k' h a, Ord a) => MinMaxFFunctorCat (k :**: k') h a where
  minimumCF :: h a -> a :* (:**:) k k' (h a) a
minimumCF h a
h =
    let (a
a, k (h a) a
f) = h a -> (a, k (h a) a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFFunctorCat k h a =>
h a -> a :* k (h a) a
minimumCF h a
h
        (a
a', k' (h a) a
f') = h a -> (a, k' (h a) a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFFunctorCat k h a =>
h a -> a :* k (h a) a
minimumCF h a
h
    in (a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
a', k (h a) a
f k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) a
f') -- min is fishy here: they should both agree
  maximumCF :: h a -> a :* (:**:) k k' (h a) a
maximumCF h a
h =
    let (a
a, k (h a) a
f) = h a -> (a, k (h a) a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFFunctorCat k h a =>
h a -> a :* k (h a) a
maximumCF h a
h
        (a
a', k' (h a) a
f') = h a -> (a, k' (h a) a)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
MinMaxFFunctorCat k h a =>
h a -> a :* k (h a) a
maximumCF h a
h
    in (a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
a', k (h a) a
f k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) a
f') -- ditto is fishy here: they should both agree

#if 0
-- forkF:
fmap unProd     :: h ((k :**: k') a b) -> h ((a `k` b) :* (a `k'` b))
unzip           :: ... -> h (a `k` b) :* h (a `k'` b)
forkF *** forkF :: ... -> (a `k` h b) :* (a `k'` h b)
prod            :: ... -> (k :**: k') a (h b)
#endif

#if 0

class OkIxCoprod k n where
  okIxCoprod :: Ok' k a |- Ok' k (n , a)

-- TODO: is there a functor-style equivalent/dual for (n , a), say some kind of
-- co-representable thingy?

-- | Indexed monoidal coproducts
class (Category k, OkIxCoprod k h) => IxMonoidalSCat k n where
  plusF :: forall a b . Ok2 k a b => h (b `k` a) -> ((n , b) `k` (n , a))

  -- -- Defaults
  -- plusF fs = joinF (zipWith (.) inF fs) <+ okIxCoprod @k @n @a
  -- {-# INLINE plusF #-}

-- | Indexed cocartesian
class IxMonoidalSCat k h => IxCoproductCat k n where
  inF   :: forall a   . Ok  k a   => h (a `k` (n , a))
  joinF :: forall a b . Ok2 k a b => h (b `k` a) -> ((n , b) `k` a)
  jamF  :: forall a   . Ok  k a   => (n , a) `k` a
  joinF fs = jamF . plusF fs <+ okIxCoprod @k @n @a <+ okIxCoprod @k @n @b
  jamF     = joinF (const id)  -- or exr if we assumed products.
  {-# INLINE joinF #-}
  {-# INLINE jamF #-}
  {-# MINIMAL inF, (joinF | jamF) #-}

instance OkIxCoprod (->) n where okIxCoprod = Entail (Sub Dict)

instance IxCoproductCat (->) n where
  inF   = (,)
  joinF = uncurry
  jamF  = snd
  {-# OPINLINE inF   #-}
  {-# OPINLINE joinF #-}
  {-# OPINLINE jamF  #-}

#if 0

-- Types for plusF default:

                   inF     :: h (a `k` (n , a))
                       fs  :: h (b `k` a)
       zipWith (.) inF fs  :: h (b `k` (n , a))
joinF (zipWith (.) inF fs) :: (n , b) `k` (n , a)

-- Types for `joinPF` default:

               fs :: h (b `k` a)
        plusPF fs :: (n , b) `k` (n , a)
jamPF . plusPF fs :: (n , b) `k` a

-- Types for `jamF` default:

       const id  :: h (a `k` a)
joinF (const id) :: (n , a) `k` a

-- Laws:

joinF inF == id
(joinF fs .) <$> inF == fs

-- Types:

       inF :: h (b `k` h b)
joinF inF :: h b `k` h b

          fs         :: h (b `k` a)
   joinF fs          :: h b `k` a
(. joinF fs)         :: (b `k` h b) -> (b `k` a)
             <$> inF :: h (b `k` h b)
(. joinF fs) <$> inF :: h (b `k` a)

#endif

instance OkIxCoprod U2 n where
  okIxCoprod = Entail (Sub Dict)

instance IxMonoidalSCat U2 n where
  plusF = const U2

instance IxCoproductCat U2 n where
  inF   = pure U2
  joinF = const U2
  jamF  = U2

instance (OkIxCoprod k n, OkIxCoprod k' n) => OkIxCoprod (k :**: k') n where
  okIxCoprod :: forall a. Ok' (k :**: k') a |- Ok' (k :**: k') (n , a)
  okIxCoprod = Entail (Sub (Dict <+ okIxCoprod @k  @n @a
                                 <+ okIxCoprod @k' @n @a))

instance (IxMonoidalSCat k n, IxMonoidalSCat k' n) => IxMonoidalSCat (k :**: k) n where
  plusF = prod . (plusF *** plusF) . unzip . fmap unProd

instance (IxCoproductCat k n, IxCoproductCat k' n) => IxCoproductCat (k :**: k') n where
  inF   = zipWith (:**:) inF inF
  joinF = prod . (joinF *** joinF) . unzip . fmap unProd
  jamF  = jamF :**: jamF

#endif

-- Functor additivity
class Additive1 h where additive1 :: Sat Additive a |- Sat Additive (h a)

instance Additive1 ((->) a) where additive1 :: forall a. Sat Additive a |- Sat Additive (a -> a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive (a -> a)))
-> Sat Additive a |- Sat Additive (a -> a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive (a -> a)))
-> Additive a :- Additive (a -> a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (a -> a))
Additive a => Dict (Additive (a -> a))
forall (a :: Constraint). a => Dict a
Dict)
instance Additive1 Sum      where additive1 :: forall a. Sat Additive a |- Sat Additive (Sum a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive (Sum a)))
-> Sat Additive a |- Sat Additive (Sum a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive (Sum a)))
-> Additive a :- Additive (Sum a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (Sum a))
Additive a => Dict (Additive (Sum a))
forall (a :: Constraint). a => Dict a
Dict)
instance Additive1 Product  where additive1 :: forall a. Sat Additive a |- Sat Additive (Product a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive (Product a)))
-> Sat Additive a |- Sat Additive (Product a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive (Product a)))
-> Additive a :- Additive (Product a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (Product a))
Additive a => Dict (Additive (Product a))
forall (a :: Constraint). a => Dict a
Dict)
instance Additive1 U1       where additive1 :: forall a. Sat Additive a |- Sat Additive (U1 a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive (U1 a)))
-> Sat Additive a |- Sat Additive (U1 a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive (U1 a)))
-> Additive a :- Additive (U1 a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (U1 a))
Additive a => Dict (Additive (U1 a))
forall (a :: Constraint). a => Dict a
Dict)
instance Additive1 Par1     where additive1 :: forall a. Sat Additive a |- Sat Additive (Par1 a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive (Par1 a)))
-> Sat Additive a |- Sat Additive (Par1 a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive (Par1 a)))
-> Additive a :- Additive (Par1 a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (Par1 a))
Additive a => Dict (Additive (Par1 a))
forall (a :: Constraint). a => Dict a
Dict)
instance (AddF f, AddF g) => Additive1 (f :*: g)  where additive1 :: forall a. Sat Additive a |- Sat Additive ((:*:) f g a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive ((:*:) f g a)))
-> Sat Additive a |- Sat Additive ((:*:) f g a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive ((:*:) f g a)))
-> Additive a :- Additive ((:*:) f g a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive ((:*:) f g a))
Additive a => Dict (Additive ((:*:) f g a))
forall (a :: Constraint). a => Dict a
Dict)
instance (AddF f, AddF g) => Additive1 (g :.: f)  where additive1 :: forall a. Sat Additive a |- Sat Additive ((:.:) g f a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive ((:.:) g f a)))
-> Sat Additive a |- Sat Additive ((:.:) g f a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive ((:.:) g f a)))
-> Additive a :- Additive ((:.:) g f a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive ((:.:) g f a))
Additive a => Dict (Additive ((:.:) g f a))
forall (a :: Constraint). a => Dict a
Dict)
instance KnownNat n       => Additive1 (Vector n) where additive1 :: forall a. Sat Additive a |- Sat Additive (Vector n a)
additive1 = (Con (Sat Additive a) :- Con (Sat Additive (Vector n a)))
-> Sat Additive a |- Sat Additive (Vector n a)
forall a b. (Con a :- Con b) -> a |- b
Entail ((Additive a => Dict (Additive (Vector n a)))
-> Additive a :- Additive (Vector n a)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (Additive (Vector n a))
Additive a => Dict (Additive (Vector n a))
forall (a :: Constraint). a => Dict a
Dict)

-- TODO: move Additive1 elsewhere

-- | Indexed coproducts as indexed products.
class (IxMonoidalPCat k h, OkIxProd k h) => IxCoproductPCat k h where
  inPF   :: forall a   . Ok  k a   => h (a `k` h a)
  joinPF :: forall a b . Ok2 k a b => h (b `k` a) -> (h b `k` a)
  -- plusPF :: forall a b . Ok2 k a b => h (b `k` a) -> (h b `k` h a)  -- same as crossPF
  jamPF  :: forall a   . Ok  k a   => h a `k` a
  -- Defaults
  -- default plusPF :: forall a b . (Zip h, Ok2 k a b) => h (b `k` a) -> (h b `k` h a)
  -- plusPF fs = joinPF (zipWith (.) inPF fs)
  --     <+ okIxProd @k @h @a
  default joinPF :: forall a b . (IxMonoidalPCat k h, Ok2 k a b) => h (b `k` a) -> (h b `k` a)
  joinPF h (k b a)
fs = k (h a) a
forall a. Ok k a => k (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxCoproductPCat k h, Ok k a) =>
k (h a) a
jamPF k (h a) a -> k (h b) (h a) -> k (h b) a
forall b c a. Ok3 k a b c => k b c -> k a b -> k a c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. h (k b a) -> k (h b) (h a)
forall a b. Ok2 k a b => h (k a b) -> k (h a) (h b)
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxMonoidalPCat k h, Ok2 k a b) =>
h (k a b) -> k (h a) (h b)
crossF h (k b a)
fs (Con (Sat (Ok k) (h a)) => k (h b) a)
-> (Sat (Ok k) a |- Sat (Ok k) (h a)) -> k (h b) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkIxProd k h =>
Ok' k a |- Ok' k (h a)
okIxProd @k @h @a (Con (Sat (Ok k) (h b)) => k (h b) a)
-> (Sat (Ok k) b |- Sat (Ok k) (h b)) -> k (h b) a
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
OkIxProd k h =>
Ok' k a |- Ok' k (h a)
okIxProd @k @h @b
  default jamPF :: forall a . (Pointed h, Ok k a) => h a `k` a
  jamPF     = h (k a a) -> k (h a) a
forall a b. Ok2 k a b => h (k b a) -> k (h b) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxCoproductPCat k h, Ok2 k a b) =>
h (k b a) -> k (h b) a
joinPF (k a a -> h (k a a)
forall a. a -> h a
forall (p :: Type -> Type) a. Pointed p => a -> p a
point k a a
forall a. Ok k a => k a a
forall (k :: Type -> Type -> Type) a. (Category k, Ok k a) => k a a
id)
  {-# INLINE joinPF #-}
  -- {-# INLINE plusPF #-}
  {-# INLINE jamPF #-}
  -- {-# MINIMAL inPF, (joinPF | (plusPF, jamPF)) #-}
  {-# MINIMAL inPF, (joinPF | jamPF) #-}

#if 0

-- Types for `joinPF` default:

               fs :: h (b `k` a)
        plusPF fs :: h b `k` h a
jamPF . plusPF fs :: h b `k` a

-- Types for `plusPF` default:

                    inPF     :: h (a `k` h a)
                         fs  :: h (b `k` a)
        zipWith (.) inPF fs  :: h (b `k` h a)
joinPF (zipWith (.) inPF fs) :: h b `k` h a

-- Types for `jamPF` via `joinPF`:

        const id  :: h (a `k` a)
joinPF (const id) :: h a `k` a

-- Laws:

joinPF inPF == id
(joinPF fs .) <$> inPF == fs

-- Types:

       inPF :: h (b `k` h b)
joinPF inPF :: h b `k` h b

          fs           :: h (b `k` a)
   joinPF fs           :: h b `k` a
(. joinPF fs)          :: (b `k` h b) -> (b `k` a)
              <$> inPF :: h (b `k` h b)
(. joinPF fs) <$> inPF :: h (b `k` a)

#endif

-- instance Summable h => IxCoproductPCat (->) h where
--   inPF      = tabulate (\ i a -> tabulate (\ j -> if i == j then a else zero))
--   plusPF    = crossF
--   jamPF     = sumA
--   {-# OPINLINE inPF #-}
--   {-# OPINLINE plusPF #-}
--   {-# OPINLINE jamPF #-}

  -- joinPF fs = jamPF . plusPF fs  -- default, so remove
  -- {-# OPINLINE joinPF #-}

-- inPF :: h (a -> h a)

-- Rep h -> a -> h a
-- Rep h -> a -> Rep h -> a

-- jamPF :: h a -> a

instance Pointed h => IxCoproductPCat U2 h where
  inPF :: forall a. Ok U2 a => h (U2 a (h a))
inPF   = U2 a (h a) -> h (U2 a (h a))
forall a. a -> h a
forall (p :: Type -> Type) a. Pointed p => a -> p a
point U2 a (h a)
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  joinPF :: forall a b. Ok2 U2 a b => h (U2 b a) -> U2 (h b) a
joinPF = U2 (h b) a -> h (U2 b a) -> U2 (h b) a
forall a. Ok (->) a => U2 (h b) a -> a -> U2 (h b) a
forall (k :: Type -> Type -> Type) b a.
(ConstCat k b, Ok k a) =>
b -> k a b
const U2 (h b) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  jamPF :: forall a. Ok U2 a => U2 (h a) a
jamPF  = U2 (h a) a
forall {k} {k} (a :: k) (b :: k). U2 a b
U2
  -- plusPF = const U2

instance (IxCoproductPCat k h, IxCoproductPCat k' h, Zip h)
      => IxCoproductPCat (k :**: k') h where
  inPF :: forall a. Ok (k :**: k') a => h ((:**:) k k' a (h a))
inPF   = (k a (h a) -> k' a (h a) -> (:**:) k k' a (h a))
-> h (k a (h a)) -> h (k' a (h a)) -> h ((:**:) k k' a (h a))
forall a b c. (a -> b -> c) -> h a -> h b -> h c
forall (f :: Type -> Type) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith k a (h a) -> k' a (h a) -> (:**:) k k' a (h a)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
(:**:) h (k a (h a))
forall a. Ok k a => h (k a (h a))
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxCoproductPCat k h, Ok k a) =>
h (k a (h a))
inPF h (k' a (h a))
forall a. Ok k' a => h (k' a (h a))
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxCoproductPCat k h, Ok k a) =>
h (k a (h a))
inPF
  joinPF :: forall a b.
Ok2 (k :**: k') a b =>
h ((:**:) k k' b a) -> (:**:) k k' (h b) a
joinPF = Prod (->) (k (h b) a) (k' (h b) a) -> (:**:) k k' (h b) a
forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k)
       (q :: k -> k -> Type).
(p a b :* q a b) -> (:**:) p q a b
prod (Prod (->) (k (h b) a) (k' (h b) a) -> (:**:) k k' (h b) a)
-> (h ((:**:) k k' b a) -> Prod (->) (k (h b) a) (k' (h b) a))
-> h ((:**:) k k' b a)
-> (:**:) k k' (h b) a
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. (h (k b a) -> k (h b) a
forall a b. Ok2 k a b => h (k b a) -> k (h b) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxCoproductPCat k h, Ok2 k a b) =>
h (k b a) -> k (h b) a
joinPF (h (k b a) -> k (h b) a)
-> (h (k' b a) -> k' (h b) a)
-> Prod (->) (h (k b a)) (h (k' b a))
-> Prod (->) (k (h b) a) (k' (h b) a)
forall a b c d.
Ok4 (->) a b c d =>
(a -> c) -> (b -> d) -> Prod (|-) a b -> Prod (|-) c d
forall (k :: Type -> Type -> Type) a b c d.
(MonoidalPCat k, Ok4 k a b c d) =>
k a c -> k b d -> k (Prod (|-) a b) (Prod (|-) c d)
*** h (k' b a) -> k' (h b) a
forall a b. Ok2 k' a b => h (k' b a) -> k' (h b) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a b.
(IxCoproductPCat k h, Ok2 k a b) =>
h (k b a) -> k (h b) a
joinPF) (Prod (->) (h (k b a)) (h (k' b a))
 -> Prod (->) (k (h b) a) (k' (h b) a))
-> (h ((:**:) k k' b a) -> Prod (->) (h (k b a)) (h (k' b a)))
-> h ((:**:) k k' b a)
-> Prod (->) (k (h b) a) (k' (h b) a)
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. h (k b a :* k' b a) -> Prod (->) (h (k b a)) (h (k' b a))
forall (f :: Type -> Type) a b.
Functor f =>
f (a :* b) -> f a :* f b
unzip (h (k b a :* k' b a) -> Prod (->) (h (k b a)) (h (k' b a)))
-> (h ((:**:) k k' b a) -> h (k b a :* k' b a))
-> h ((:**:) k k' b a)
-> Prod (->) (h (k b a)) (h (k' b a))
forall b c a. Ok3 (->) a b c => (b -> c) -> (a -> b) -> a -> c
forall (k :: Type -> Type -> Type) b c a.
(Category k, Ok3 k a b c) =>
k b c -> k a b -> k a c
. ((:**:) k k' b a -> k b a :* k' b a)
-> h ((:**:) k k' b a) -> h (k b a :* k' b a)
forall a b. (a -> b) -> h a -> h b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (:**:) k k' b a -> k b a :* k' b a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
(:**:) p q a b -> p a b :* q a b
unProd
  jamPF :: forall a. Ok (k :**: k') a => (:**:) k k' (h a) a
jamPF  = k (h a) a
forall a. Ok k a => k (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxCoproductPCat k h, Ok k a) =>
k (h a) a
jamPF k (h a) a -> k' (h a) a -> (:**:) k k' (h a) a
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (h a) a
forall a. Ok k' a => k' (h a) a
forall (k :: Type -> Type -> Type) (h :: Type -> Type) a.
(IxCoproductPCat k h, Ok k a) =>
k (h a) a
jamPF
  -- plusPF = prod . (plusPF *** plusPF) . unzip . fmap unProd

{--------------------------------------------------------------------
    Finite
--------------------------------------------------------------------}

class FiniteCat k where
  unFinite     :: KnownNat n => Finite n `k` Int
  unsafeFinite :: KnownNat n => Int `k` Finite n

instance FiniteCat (->) where
  unsafeFinite :: KnownNat n => Int -> Finite n
  unsafeFinite :: forall (n :: Nat). KnownNat n => Int -> Finite n
unsafeFinite Int
n = Integer -> Finite n
forall (n :: Nat). Integer -> Finite n
Finite (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  unFinite :: Finite n -> Int
  unFinite :: forall (n :: Nat). Finite n -> Int
unFinite (Finite Integer
n) = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
  {-# OPINLINE unsafeFinite #-}
  {-# OPINLINE unFinite #-}

instance (FiniteCat k,FiniteCat k') => FiniteCat (k :**: k') where
  unFinite :: forall (n :: Nat). KnownNat n => (:**:) k k' (Finite n) Int
unFinite     = k (Finite n) Int
forall (n :: Nat). KnownNat n => k (Finite n) Int
forall (k :: Type -> Type -> Type) (n :: Nat).
(FiniteCat k, KnownNat n) =>
k (Finite n) Int
unFinite     k (Finite n) Int -> k' (Finite n) Int -> (:**:) k k' (Finite n) Int
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' (Finite n) Int
forall (n :: Nat). KnownNat n => k' (Finite n) Int
forall (k :: Type -> Type -> Type) (n :: Nat).
(FiniteCat k, KnownNat n) =>
k (Finite n) Int
unFinite
  unsafeFinite :: forall (n :: Nat). KnownNat n => (:**:) k k' Int (Finite n)
unsafeFinite = k Int (Finite n)
forall (n :: Nat). KnownNat n => k Int (Finite n)
forall (k :: Type -> Type -> Type) (n :: Nat).
(FiniteCat k, KnownNat n) =>
k Int (Finite n)
unsafeFinite k Int (Finite n) -> k' Int (Finite n) -> (:**:) k k' Int (Finite n)
forall {k} {k} (p :: k -> k -> Type) (q :: k -> k -> Type) (a :: k)
       (b :: k).
p a b -> q a b -> (:**:) p q a b
:**: k' Int (Finite n)
forall (n :: Nat). KnownNat n => k' Int (Finite n)
forall (k :: Type -> Type -> Type) (n :: Nat).
(FiniteCat k, KnownNat n) =>
k Int (Finite n)
unsafeFinite

#if 0
{--------------------------------------------------------------------
    Obsolete
--------------------------------------------------------------------}

-- | Alias for '(***)'
(++++) :: (MonoidalPCat k, Ok4 k a b c d) =>
          (c `k` a) -> (d `k` b) -> (CoprodP k c d `k` CoprodP k a b)
(++++) = (***)
{-# INLINE (++++) #-}

-- Alias for 'crossF'
plusPF :: (IxMonoidalPCat k h, Ok2 k a b) => h (b `k` a) -> (h b `k` h a)
plusPF = crossF
{-# INLINE plusPF #-}
#endif

#if 0

{--------------------------------------------------------------------
    Experimental
--------------------------------------------------------------------}

-- Experimentally moved from ConCat.AltCat
crossSecondFirst :: forall k a b c d. (MonoidalPCat k, Ok4 k a b c d)
                 => a `k` c -> b `k` d -> (a :* b) `k` (c :* d)
f `crossSecondFirst` g = second g . first f
                         <+ okProd @k @a @b
                         <+ okProd @k @c @b
                         <+ okProd @k @c @d
{-# INLINE crossSecondFirst #-}

#endif