-- https://github.com/compiling-to-categories/concat/blob/84900a2937cdfdfe7fcc773f18b4a4ddcf5251ee/classes/src/ConCat/Category.hs

{-# 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 #-}

infixr 9 ∘
infixr 3 △

class Category k where
  id :: k a a
  (∘) :: k b c -> k a b -> k a c

class Category k => Cartesian k where
  (△) :: k a b -> k a c -> k a (b,c)
  -- I wonder why ex{l,r} was chosen as the name
  exl :: k (a,b) a
  exr :: k (a,b) b

instance Category (->) where
  id = \x -> x
  g ∘ f = \x -> g (f x)

instance Cartesian (->) where
  f △ g = \x -> (f x, g x)
  exl = \(a, _) -> a
  exr = \(_, b) -> b