Identity.hs

-- | The identity profunctor 'Id', wrapping the hom arrows of a category. It is the unit of profunctor
-- composition ("Proarrow.Profunctor.Instance.Composition") and the identity 'Promonad'.
module Proarrow.Profunctor.Instance.Identity where

import Proarrow.Category.Enriched.Dagger (Dagger, DaggerProfunctor (..))
import Proarrow.Category.Enriched.Thin (DecidableProfunctor (..), Thin, ThinProfunctor (..), mapDecision)
import Proarrow.Core (CAT, CategoryOf (..), Hom, Profunctor (..), Promonad (..))
import Proarrow.Functor (FunctorForRep (..))

-- | The identity profunctor: the hom arrows of the category wrapped as a data type. It is the unit
-- of profunctor composition and the identity 'Promonad'.
type Id :: CAT k
newtype Id a b = Id {unId :: a ~> b}

instance (CategoryOf k) => Profunctor (Id :: CAT k) where
  lmap l (Id f) = Id (f . l)
  rmap r (Id f) = Id (r . f)
  r \\ Id f = r \\ f

instance (CategoryOf k) => Promonad (Id :: CAT k) where
  id = Id id
  Id f . Id g = Id (f . g)

instance (CategoryOf k) => FunctorForRep (Id :: CAT k) where
  type Id @ a = a
  fmap f = f

instance (Dagger k) => DaggerProfunctor (Id :: CAT k) where
  dagger (Id p) = Id (dagger p)

instance (Thin k) => ThinProfunctor (Id :: CAT k) where
  type HasArrow (Id :: CAT k) a b = HasArrow (Hom k) a b
  arr = Id arr
  withArr (Id f) r = withArr f r

instance (DecidableProfunctor (Hom k)) => DecidableProfunctor (Id :: CAT k) where
  type Holds (Id :: CAT k) a b = Holds (Hom k) a b
  decide @a @b = mapDecision Id (decide @(Hom k) @a @b)
  toHolds (Id f) r = toHolds f r