{-# LANGUAGE
FlexibleContexts,
FlexibleInstances,
GADTs,
MultiParamTypeClasses,
RankNTypes,
ScopedTypeVariables,
TypeOperators,
TypeFamilies,
TypeSynonymInstances,
UndecidableInstances #-}------------------------------------------------------------------------------- |-- Module : Data.Category.Limit-- License : BSD-style (see the file LICENSE)---- Maintainer : sjoerd@w3future.com-- Stability : experimental-- Portability : non-portable-----------------------------------------------------------------------------moduleData.Category.Limit(-- * Preliminairies-- ** Diagonal FunctorDiag(..),DiagF-- ** Cones,Cone,Cocone,coneVertex,coconeVertex-- * Limits,LimitFam,Limit,HasLimits(..),LimitFunctor(..),limitAdj-- * Colimits,ColimitFam,Colimit,HasColimits(..),ColimitFunctor(..),colimitAdj-- ** Limits of type Void,HasTerminalObject(..),HasInitialObject(..),Zero-- ** Limits of type Pair,BinaryProduct,HasBinaryProducts(..),ProductFunctor(..),(:*:)(..),BinaryCoproduct,HasBinaryCoproducts(..),CoproductFunctor(..),(:+:)(..)-- -- ** Limits of type Hask-- , ForAll(..)-- , Exists(..))whereimportPreludehiding((.),Functor,product)importqualifiedControl.ArrowasA((&&&),(***),(|||),(+++))importData.CategoryimportData.Category.FunctorimportData.Category.NaturalTransformationimportData.Category.AdjunctionimportData.Category.ProductimportData.Category.CoproductimportData.Category.Discreteinfixl3***infixl3&&&infixl2+++infixl2|||dataDiag::(*->*->*)->(*->*->*)->*whereDiag::Diagj(~>)typeinstanceDom(Diagj(~>))=(~>)typeinstanceCod(Diagj(~>))=Natj(~>)typeinstanceDiagj(~>):%a=Constj(~>)a-- | The diagonal functor from (index-) category J to (~>).instance(Categoryj,Category(~>))=>Functor(Diagj(~>))whereDiag%f=Nat(Const$srcf)(Const$tgtf)$constf-- | The diagonal functor with the same domain and codomain as @f@.typeDiagFf=Diag(Domf)(Codf)-- | A cone from N to F is a natural transformation from the constant functor to N to F.typeConefn=Nat(Domf)(Codf)(ConstFfn)f-- | A co-cone from F to N is a natural transformation from F to the constant functor to N.typeCoconefn=Nat(Domf)(Codf)f(ConstFfn)-- | The vertex (or apex) of a cone.coneVertex::Conefn->Obj(Codf)nconeVertex(Nat(Constx)__)=x-- | The vertex (or apex) of a co-cone.coconeVertex::Coconefn->Obj(Codf)ncoconeVertex(Nat_(Constx)_)=x-- | Limits in a category @(~>)@ by means of a diagram of type @j@, which is a functor from @j@ to @(~>)@.typefamilyLimitFamj(~>)f::*typeLimitf=LimitFam(Domf)(Codf)f-- | An instance of @HasLimits j (~>)@ says that @(~>)@ has all limits of type @j@.class(Categoryj,Category(~>))=>HasLimitsj(~>)where-- | 'limit' returns the limiting cone for a functor @f@.limit::Obj(Natj(~>))f->Conef(Limitf)-- | 'limitFactorizer' shows that the limiting cone is universal – i.e. any other cone of @f@ factors through it –-- by returning the morphism between the vertices of the cones.limitFactorizer::Obj(Natj(~>))f->(foralln.Conefn->n~>Limitf)dataLimitFunctor(j::*->*->*)((~>)::*->*->*)=LimitFunctortypeinstanceDom(LimitFunctorj(~>))=Natj(~>)typeinstanceCod(LimitFunctorj(~>))=(~>)typeinstanceLimitFunctorj(~>):%f=LimitFamj(~>)f-- | If every diagram of type @j@ has a limit in @(~>)@ there exists a limit functor.-- It can be seen as a generalisation of @(***)@.instanceHasLimitsj(~>)=>Functor(LimitFunctorj(~>))whereLimitFunctor%n@Nat{}=limitFactorizer(tgtn)(n.limit(srcn))-- | The limit functor is right adjoint to the diagonal functor.limitAdj::HasLimitsj(~>)=>Adjunction(Natj(~>))(~>)(Diagj(~>))(LimitFunctorj(~>))limitAdj=mkAdjunctiondiagLimitFunctor(\a->limitFactorizer(diag%a)(diag%a))(\f@Nat{}->limitf)wherediag=Diag-- Forces the type of all Diags to be the same.-- | Colimits in a category @(~>)@ by means of a diagram of type @j@, which is a functor from @j@ to @(~>)@.typefamilyColimitFamj(~>)f::*typeColimitf=ColimitFam(Domf)(Codf)f-- | An instance of @HasColimits j (~>)@ says that @(~>)@ has all colimits of type @j@.class(Categoryj,Category(~>))=>HasColimitsj(~>)where-- | 'colimit' returns the limiting co-cone for a functor @f@.colimit::Obj(Natj(~>))f->Coconef(Colimitf)-- | 'colimitFactorizer' shows that the limiting co-cone is universal – i.e. any other co-cone of @f@ factors through it –-- by returning the morphism between the vertices of the cones.colimitFactorizer::Obj(Natj(~>))f->(foralln.Coconefn->Colimitf~>n)dataColimitFunctor(j::*->*->*)((~>)::*->*->*)=ColimitFunctortypeinstanceDom(ColimitFunctorj(~>))=Natj(~>)typeinstanceCod(ColimitFunctorj(~>))=(~>)typeinstanceColimitFunctorj(~>):%f=ColimitFamj(~>)f-- | If every diagram of type @j@ has a colimit in @(~>)@ there exists a colimit functor.-- It can be seen as a generalisation of @(+++)@.instanceHasColimitsj(~>)=>Functor(ColimitFunctorj(~>))whereColimitFunctor%n@Nat{}=colimitFactorizer(srcn)(colimit(tgtn).n)-- | The colimit functor is left adjoint to the diagonal functor.colimitAdj::HasColimitsj(~>)=>Adjunction(~>)(Natj(~>))(ColimitFunctorj(~>))(Diagj(~>))colimitAdj=mkAdjunctionColimitFunctordiag(\f@Nat{}->colimitf)(\a->colimitFactorizer(diag%a)(diag%a))wherediag=Diag-- Forces the type of all Diags to be the same.classCategory(~>)=>HasTerminalObject(~>)wheretypeTerminalObject(~>)::*terminalObject::Obj(~>)(TerminalObject(~>))terminate::Obj(~>)a->a~>TerminalObject(~>)typeinstanceLimitFamVoid(~>)f=TerminalObject(~>)-- | A terminal object is the limit of the functor from /0/ to (~>).instance(HasTerminalObject(~>))=>HasLimitsVoid(~>)wherelimit(Natf__)=voidNat(ConstterminalObject)flimitFactorizerNat{}=terminate.coneVertex-- | @()@ is the terminal object in @Hask@.instanceHasTerminalObject(->)wheretypeTerminalObject(->)=()terminalObject=idterminate__=()-- | @Unit@ is the terminal category.instanceHasTerminalObjectCatwheretypeTerminalObjectCat=CatWUnitterminalObject=CatAIdterminate(CatA_)=CatA$ConstZ-- | The constant functor to the terminal object is itself the terminal object in its functor category.instance(Categoryc,HasTerminalObjectd)=>HasTerminalObject(Natcd)wheretypeTerminalObject(Natcd)=Constcd(TerminalObjectd)terminalObject=natId$ConstterminalObjectterminate(Natf__)=Natf(ConstterminalObject)$terminate.(f%)-- | The terminal object of the product of 2 categories is the product of their terminal objects.instance(HasTerminalObjectc1,HasTerminalObjectc2)=>HasTerminalObject(c1:**:c2)wheretypeTerminalObject(c1:**:c2)=(TerminalObjectc1,TerminalObjectc2)terminalObject=terminalObject:**:terminalObjectterminate(a1:**:a2)=terminatea1:**:terminatea2classCategory(~>)=>HasInitialObject(~>)wheretypeInitialObject(~>)::*initialObject::Obj(~>)(InitialObject(~>))initialize::Obj(~>)a->InitialObject(~>)~>atypeinstanceColimitFamVoid(~>)f=InitialObject(~>)-- | An initial object is the colimit of the functor from /0/ to (~>).instanceHasInitialObject(~>)=>HasColimitsVoid(~>)wherecolimit(Natf__)=voidNatf(ConstinitialObject)colimitFactorizerNat{}=initialize.coconeVertexdataZero-- | Any empty data type is an initial object in @Hask@.instanceHasInitialObject(->)wheretypeInitialObject(->)=ZeroinitialObject=id-- With thanks to Conor McBrideinitialize_x=x`seq`error"we never get this far"-- | The empty category is the initial object in @Cat@.instanceHasInitialObjectCatwheretypeInitialObjectCat=CatWVoidinitialObject=CatAIdinitialize(CatA_)=CatANil-- | The constant functor to the initial object is itself the initial object in its functor category.instance(Categoryc,HasInitialObjectd)=>HasInitialObject(Natcd)wheretypeInitialObject(Natcd)=Constcd(InitialObjectd)initialObject=natId$ConstinitialObjectinitialize(Natf__)=Nat(ConstinitialObject)f$initialize.(f%)-- | The initial object of the product of 2 categories is the product of their initial objects.instance(HasInitialObjectc1,HasInitialObjectc2)=>HasInitialObject(c1:**:c2)wheretypeInitialObject(c1:**:c2)=(InitialObjectc1,InitialObjectc2)initialObject=initialObject:**:initialObjectinitialize(a1:**:a2)=initializea1:**:initializea2typefamilyBinaryProduct((~>)::*->*->*)xy::*classCategory(~>)=>HasBinaryProducts(~>)whereproj1::Obj(~>)x->Obj(~>)y->BinaryProduct(~>)xy~>xproj2::Obj(~>)x->Obj(~>)y->BinaryProduct(~>)xy~>y(&&&)::(a~>x)->(a~>y)->(a~>BinaryProduct(~>)xy)(***)::(a1~>b1)->(a2~>b2)->(BinaryProduct(~>)a1a2~>BinaryProduct(~>)b1b2)l***r=(l.proj1(srcl)(srcr))&&&(r.proj2(srcl)(srcr))typeinstanceLimitFam(Discrete(Sn))(~>)f=BinaryProduct(~>)(f:%Z)(LimitFam(Discreten)(~>)(f:.:Succn))-- | The product of @n@ objects is the limit of the functor from @Discrete n@ to @(~>)@.instance(HasLimits(Discreten)(~>),HasBinaryProducts(~>))=>HasLimits(Discrete(Sn))(~>)wherelimit=limit'wherelimit'::forallf.Obj(Nat(Discrete(Sn))(~>))f->Conef(Limitf)limit'l@Nat{}=Nat(Const$x***y)(srcFl)(\z->unCom$hz)wherex=l!Zy=coneVertexlimNextlimNext=limit(l`o`natIdSucc)h::Obj(Discrete(Sn))z->Com(ConstFf(LimitFam(Discrete(Sn))(~>)f))fzhZ=Com$proj1xyh(Sn)=Com$limNext!n.proj2xylimitFactorizerl@Nat{}c=c!Z&&&limitFactorizer(l`o`natIdSucc)((c`o`natIdSucc).constPostcompInv(srcFc)Succ)typeinstanceBinaryProduct(->)xy=(x,y)-- | The tuple is the binary product in @Hask@.instanceHasBinaryProducts(->)whereproj1__=fstproj2__=snd(&&&)=(A.&&&)(***)=(A.***)typeinstanceBinaryProductCat(CatWc1)(CatWc2)=CatW(c1:**:c2)-- | The product of categories '(:**:)' is the binary product in 'Cat'.instanceHasBinaryProductsCatwhereproj1(CatA_)(CatA_)=CatAProj1proj2(CatA_)(CatA_)=CatAProj2CatAf1&&&CatAf2=CatA((f1:***:f2):.:DiagProd)CatAf1***CatAf2=CatA(f1:***:f2)typeinstanceBinaryProduct(c1:**:c2)(x1,x2)(y1,y2)=(BinaryProductc1x1y1,BinaryProductc2x2y2)-- | The binary product of the product of 2 categories is the product of their binary products.instance(HasBinaryProductsc1,HasBinaryProductsc2)=>HasBinaryProducts(c1:**:c2)whereproj1(x1:**:x2)(y1:**:y2)=proj1x1y1:**:proj1x2y2proj2(x1:**:x2)(y1:**:y2)=proj2x1y1:**:proj2x2y2(f1:**:f2)&&&(g1:**:g2)=(f1&&&g1):**:(f2&&&g2)(f1:**:f2)***(g1:**:g2)=(f1***g1):**:(f2***g2)dataProductFunctor((~>)::*->*->*)=ProductFunctortypeinstanceDom(ProductFunctor(~>))=(~>):**:(~>)typeinstanceCod(ProductFunctor(~>))=(~>)typeinstanceProductFunctor(~>):%(a,b)=BinaryProduct(~>)ab-- | Binary product as a bifunctor.instanceHasBinaryProducts(~>)=>Functor(ProductFunctor(~>))whereProductFunctor%(a1:**:a2)=a1***a2datap:*:qwhere(:*:)::(Functorp,Functorq,Domp~Domq,Codp~(~>),Codq~(~>),HasBinaryProducts(~>))=>p->q->p:*:qtypeinstanceDom(p:*:q)=DomptypeinstanceCod(p:*:q)=Codptypeinstance(p:*:q):%a=BinaryProduct(Codp)(p:%a)(q:%a)-- | The product of two functors, passing the same object to both functors and taking the product of the results.instance(Category(Domp),Category(Codp))=>Functor(p:*:q)where(p:*:q)%f=(p%f)***(q%f)typeinstanceBinaryProduct(Natcd)xy=x:*:y-- | The functor product '(:*:)' is the binary product in functor categories.instance(Categoryc,HasBinaryProductsd)=>HasBinaryProducts(Natcd)whereproj1(Natf__)(Natg__)=Nat(f:*:g)f$\z->proj1(f%z)(g%z)proj2(Natf__)(Natg__)=Nat(f:*:g)g$\z->proj2(f%z)(g%z)Natafaf&&&Nat_gag=Nata(f:*:g)$\z->afz&&&agzNatf1f2f***Natg1g2g=Nat(f1:*:g1)(f2:*:g2)$\z->fz***gztypefamilyBinaryCoproduct((~>)::*->*->*)xy::*classCategory(~>)=>HasBinaryCoproducts(~>)whereinj1::Obj(~>)x->Obj(~>)y->x~>BinaryCoproduct(~>)xyinj2::Obj(~>)x->Obj(~>)y->y~>BinaryCoproduct(~>)xy(|||)::(x~>a)->(y~>a)->(BinaryCoproduct(~>)xy~>a)(+++)::(a1~>b1)->(a2~>b2)->(BinaryCoproduct(~>)a1a2~>BinaryCoproduct(~>)b1b2)l+++r=(inj1(tgtl)(tgtr).l)|||(inj2(tgtl)(tgtr).r)typeinstanceColimitFam(Discrete(Sn))(~>)f=BinaryCoproduct(~>)(f:%Z)(ColimitFam(Discreten)(~>)(f:.:Succn))-- | The coproduct of @n@ objects is the colimit of the functor from @Discrete n@ to @(~>)@.instance(HasColimits(Discreten)(~>),HasBinaryCoproducts(~>))=>HasColimits(Discrete(Sn))(~>)wherecolimit=colimit'wherecolimit'::forallf.Obj(Nat(Discrete(Sn))(~>))f->Coconef(Colimitf)colimit'l@Nat{}=Nat(srcFl)(Const$x+++y)(\z->unCom$hz)wherex=l!Zy=coconeVertexcolNextcolNext=colimit(l`o`natIdSucc)h::Obj(Discrete(Sn))z->Comf(ConstFf(ColimitFam(Discrete(Sn))(~>)f))zhZ=Com$inj1xyh(Sn)=Com$inj2xy.colNext!ncolimitFactorizerl@Nat{}c=c!Z|||colimitFactorizer(l`o`natIdSucc)(constPostcomp(tgtFc)Succ.(c`o`natIdSucc))typeinstanceBinaryCoproduct(->)xy=Eitherxy-- | 'Either' is the coproduct in @Hask@.instanceHasBinaryCoproducts(->)whereinj1__=Leftinj2__=Right(|||)=(A.|||)(+++)=(A.+++)typeinstanceBinaryCoproductCat(CatWc1)(CatWc2)=CatW(c1:++:c2)-- | The coproduct of categories '(:++:)' is the binary coproduct in 'Cat'.instanceHasBinaryCoproductsCatwhereinj1(CatA_)(CatA_)=CatAInj1inj2(CatA_)(CatA_)=CatAInj2CatAf1|||CatAf2=CatA(CodiagCoprod:.:(f1:+++:f2))CatAf1+++CatAf2=CatA(f1:+++:f2)typeinstanceBinaryCoproduct(c1:**:c2)(x1,x2)(y1,y2)=(BinaryCoproductc1x1y1,BinaryCoproductc2x2y2)-- | The binary coproduct of the product of 2 categories is the product of their binary coproducts.instance(HasBinaryCoproductsc1,HasBinaryCoproductsc2)=>HasBinaryCoproducts(c1:**:c2)whereinj1(x1:**:x2)(y1:**:y2)=inj1x1y1:**:inj1x2y2inj2(x1:**:x2)(y1:**:y2)=inj2x1y1:**:inj2x2y2(f1:**:f2)|||(g1:**:g2)=(f1|||g1):**:(f2|||g2)(f1:**:f2)+++(g1:**:g2)=(f1+++g1):**:(f2+++g2)dataCoproductFunctor((~>)::*->*->*)=CoproductFunctortypeinstanceDom(CoproductFunctor(~>))=(~>):**:(~>)typeinstanceCod(CoproductFunctor(~>))=(~>)typeinstanceCoproductFunctor(~>):%(a,b)=BinaryCoproduct(~>)ab-- | Binary coproduct as a bifunctor.instanceHasBinaryCoproducts(~>)=>Functor(CoproductFunctor(~>))whereCoproductFunctor%(a1:**:a2)=a1+++a2datap:+:qwhere(:+:)::(Functorp,Functorq,Domp~Domq,Codp~(~>),Codq~(~>),HasBinaryCoproducts(~>))=>p->q->p:+:qtypeinstanceDom(p:+:q)=DomptypeinstanceCod(p:+:q)=Codptypeinstance(p:+:q):%a=BinaryCoproduct(Codp)(p:%a)(q:%a)-- | The coproduct of two functors, passing the same object to both functors and taking the coproduct of the results.instance(Category(Domp),Category(Codp))=>Functor(p:+:q)where(p:+:q)%f=(p%f)+++(q%f)typeinstanceBinaryCoproduct(Natcd)xy=x:+:y-- | The functor coproduct '(:+:)' is the binary coproduct in functor categories.instance(Categoryc,HasBinaryCoproductsd)=>HasBinaryCoproducts(Natcd)whereinj1(Natf__)(Natg__)=Natf(f:+:g)$\z->inj1(f%z)(g%z)inj2(Natf__)(Natg__)=Natg(f:+:g)$\z->inj2(f%z)(g%z)Natfafa|||Natg_ga=Nat(f:+:g)a$\z->faz|||gazNatf1f2f+++Natg1g2g=Nat(f1:+:g1)(f2:+:g2)$\z->fz+++gz-- newtype ForAll f = ForAll { unForAll :: forall a. f :% a }-- -- type instance LimitFam (->) (->) f = ForAll f-- -- instance HasLimits (->) (->) where-- -- limit (Nat f _ _) = Nat (Const id) f $ \_ -> unForAll-- limitFactorizer Nat{} c n = ForAll $ (c ! id) n -- ForAll . (c ! id)-- -- -- data Exists f = forall a. Exists (f :% a)-- -- type instance ColimitFam (->) (->) f = Exists f-- -- instance HasColimits (->) (->) where-- -- colimit (Nat f _ _) = Nat f (Const id) $ \_ -> Exists-- colimitFactorizer Nat{} c (Exists fa) = (c ! id) fa -- (c ! id) . unExists