diff --git a/category-extras.cabal b/category-extras.cabal --- a/category-extras.cabal +++ b/category-extras.cabal @@ -1,164 +1,167 @@ -name: category-extras -category: Control, Monads, Comonads -version: 0.53.1 -license: BSD3 -cabal-version: >= 1.2 -license-file: LICENSE -author: Edward A. Kmett, Dave Menendez -maintainer: Edward A. Kmett -stability: experimental -homepage: http://comonad.com/reader/ -synopsis: Various modules and constructs inspired by category theory -copyright: Copyright (C) 2008 Edward A. Kmett - Copyright (C) 2004--2008 Dave Menendez - Copyright (C) 2007 Iavor Diatchki -description: A vastly expanded collection of modules implementing various - ideas from category theory. Notable bits include: comonads, - adjunctions, functor fixedpoints and various recursion - operaters ala /Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire/. -build-type: Simple +name: category-extras +category: Control, Monads, Comonads +version: 0.53.3 +license: BSD3 +cabal-version: >= 1.2 +license-file: LICENSE +author: Edward A. Kmett, Dave Menendez +maintainer: Edward A. Kmett +stability: experimental +homepage: http://comonad.com/reader/ +synopsis: Various modules and constructs inspired by category theory +copyright: Copyright (C) 2008 Edward A. Kmett, + Copyright (C) 2004--2008 Dave Menendez, + Copyright (C) 2007 Iavor Diatchki +description: A vastly expanded collection of modules implementing various + ideas from category theory. Notable bits include: comonads, + adjunctions, and various recursion schemes ala + /Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire/. +build-type: Simple flag ArrowSubclassesCategory - description: Indicates Control.Category is available and that the standard library has - its arrows subclass Control.Category.Category - default: True + description: Indicates Control.Category is available and that the standard library has + its arrows subclass Control.Category.Category + default: True flag TypeFamilies - description: Support for Type Families is available to us + description: Support for Type Families is available to us flag Optimize - description: Enable optimizations - default: False + description: Enable optimizations + default: False library - build-depends: mtl >= 1.1 - extensions: - CPP, - EmptyDataDecls, - FlexibleContexts, - FlexibleInstances, - FunctionalDependencies, - MultiParamTypeClasses, - TypeOperators, - TypeSynonymInstances - UndecidableInstances, - ExistentialQuantification, - Rank2Types + build-depends: mtl >= 1.1 + extensions: + CPP, + EmptyDataDecls, + FlexibleContexts, + FlexibleInstances, + FunctionalDependencies, + MultiParamTypeClasses, + TypeOperators, + TypeSynonymInstances + UndecidableInstances, + ExistentialQuantification, + Rank2Types - other-modules: - Control.Functor.Internal.Adjunction, - Control.Functor.Internal.Ideal + other-modules: + Control.Functor.Internal.Adjunction, + Control.Functor.Internal.Ideal - exposed-modules: - Control.Category.Monoidal, - Control.Category.Cartesian, - Control.Category.Cartesian.Closed, - Control.Applicative.Parameterized, - Control.Arrow.BiKleisli, - Control.Arrow.CoKleisli, - Control.Category.Associative, - Control.Category.Braided, - Control.Category.Discrete, - Control.Category.Distributive, - Control.Category.Dual, - Control.Category.Hask, - Control.Category.Object, - Control.Comonad, - Control.Comonad.Cofree, - Control.Comonad.Context, - Control.Comonad.Coideal, - Control.Comonad.Density, - Control.Comonad.Fix, - Control.Comonad.Indexed, - Control.Comonad.HigherOrder, - Control.Comonad.Parameterized, - Control.Comonad.Pointer, - Control.Comonad.Reader, - Control.Comonad.Stream, - Control.Comonad.Supply, - Control.Comonad.Trans, - Control.Functor, - Control.Functor.Adjunction, - Control.Functor.Adjunction.HigherOrder, - Control.Functor.Algebra, - Control.Functor.Algebra.Elgot, - Control.Functor.Categorical, - Control.Functor.Cone, - Control.Functor.Composition, - Control.Functor.Combinators.Const, - Control.Functor.Combinators.Lift, - Control.Functor.Combinators.Join, - Control.Functor.Combinators.Biff, - Control.Functor.Combinators.Flip, - Control.Functor.Combinators.Of, - Control.Functor.Contra, - Control.Functor.Extras, - Control.Functor.Exponential, - Control.Functor.Fix, - Control.Functor.Full, - Control.Functor.HigherOrder, - Control.Functor.HigherOrder.Composition, - Control.Functor.Indexed, - Control.Functor.KanExtension, - Control.Functor.KanExtension.Interpreter, - Control.Functor.Lambek, - Control.Functor.Limit, - Control.Functor.Pointed, - Control.Functor.Pointed.Composition, - Control.Functor.Representable, - Control.Functor.Strong, - Control.Functor.Yoneda, - Control.Functor.Zip, - Control.Functor.Zap, - Control.Monad.Categorical, - Control.Monad.Codensity, - Control.Monad.Free, - Control.Monad.HigherOrder, - Control.Monad.Ideal, - Control.Monad.Indexed, - Control.Monad.Indexed.Cont, - Control.Monad.Indexed.Fix, - Control.Monad.Indexed.State, - Control.Monad.Indexed.Trans, - Control.Monad.Parameterized, - Control.Monad.Hyper, - Control.Monad.Either, - Control.Morphism.Ana, - Control.Morphism.Apo, - Control.Morphism.Build, - Control.Morphism.Cata, - Control.Morphism.Chrono, - Control.Morphism.Destroy, - Control.Morphism.Dyna, - Control.Morphism.Exo, - Control.Morphism.Futu, - Control.Morphism.Histo, - Control.Morphism.Hylo, - Control.Morphism.Meta.Gibbons, - Control.Morphism.Meta.Erwig, - Control.Morphism.Para, - Control.Morphism.Postpro, - Control.Morphism.Prepro, - Control.Morphism.Span, - Control.Morphism.Synchro, - Control.Morphism.Universal, - Control.Morphism.Zygo, - Data.Void + exposed-modules: + Control.Category.Monoidal, + Control.Category.Cartesian, + Control.Category.Cartesian.Closed, + Control.Applicative.Parameterized, + Control.Allegory, + Control.Arrow.BiKleisli, + Control.Arrow.CoKleisli, + Control.Category.Associative, + Control.Category.Braided, + Control.Category.Discrete, + Control.Category.Distributive, + Control.Category.Dual, + Control.Category.Hask, + Control.Category.Object, + Control.Comonad, + Control.Comonad.Cofree, + Control.Comonad.Context, + Control.Comonad.Coideal, + Control.Comonad.Density, + Control.Comonad.Exponent, + Control.Comonad.Fix, + Control.Comonad.Indexed, + Control.Comonad.HigherOrder, + Control.Comonad.Parameterized, + Control.Comonad.Pointer, + Control.Comonad.Reader, + Control.Comonad.Stream, + Control.Comonad.Supply, + Control.Comonad.Trans, + Control.Dyad, + Control.Functor, + Control.Functor.Adjunction, + Control.Functor.Adjunction.HigherOrder, + Control.Functor.Algebra, + Control.Functor.Algebra.Elgot, + Control.Functor.Categorical, + Control.Functor.Cone, + Control.Functor.Composition, + Control.Functor.Combinators.Const, + Control.Functor.Combinators.Lift, + Control.Functor.Combinators.Join, + Control.Functor.Combinators.Biff, + Control.Functor.Combinators.Flip, + Control.Functor.Combinators.Of, + Control.Functor.Contra, + Control.Functor.Extras, + Control.Functor.Exponential, + Control.Functor.Fix, + Control.Functor.Full, + Control.Functor.HigherOrder, + Control.Functor.HigherOrder.Composition, + Control.Functor.Indexed, + Control.Functor.KanExtension, + Control.Functor.KanExtension.Interpreter, + Control.Functor.Lambek, + Control.Functor.Limit, + Control.Functor.Pointed, + Control.Functor.Pointed.Composition, + Control.Functor.Representable, + Control.Functor.Strong, + Control.Functor.Yoneda, + Control.Functor.Zip, + Control.Functor.Zap, + Control.Monad.Categorical, + Control.Monad.Codensity, + Control.Monad.Free, + Control.Monad.HigherOrder, + Control.Monad.Ideal, + Control.Monad.Indexed, + Control.Monad.Indexed.Cont, + Control.Monad.Indexed.Fix, + Control.Monad.Indexed.State, + Control.Monad.Indexed.Trans, + Control.Monad.Parameterized, + Control.Monad.Hyper, + Control.Monad.Either, + Control.Morphism.Ana, + Control.Morphism.Apo, + Control.Morphism.Build, + Control.Morphism.Cata, + Control.Morphism.Chrono, + Control.Morphism.Destroy, + Control.Morphism.Dyna, + Control.Morphism.Exo, + Control.Morphism.Futu, + Control.Morphism.Histo, + Control.Morphism.Hylo, + Control.Morphism.Meta.Gibbons, + Control.Morphism.Meta.Erwig, + Control.Morphism.Para, + Control.Morphism.Postpro, + Control.Morphism.Prepro, + Control.Morphism.Span, + Control.Morphism.Synchro, + Control.Morphism.Universal, + Control.Morphism.Zygo, + Data.Void - hs-source-dirs: src - ghc-options: -Wall + hs-source-dirs: src + ghc-options: -Wall - if flag(ArrowSubclassesCategory) - build-depends: ghc >= 6.9, base > 3, array - cpp-options: -D__ARROW_SUBCLASSES_CATEGORY__=1 - else - build-depends: ghc < 6.9, base, array - hs-source-dirs: pre-6.9 - exposed-modules: Control.Category + if flag(ArrowSubclassesCategory) + build-depends: ghc >= 6.9, base > 3, array + cpp-options: -D__ARROW_SUBCLASSES_CATEGORY__=1 + else + build-depends: ghc < 6.9, base, array + hs-source-dirs: pre-6.9 + exposed-modules: Control.Category - if flag(TypeFamilies) - extensions: TypeFamilies - cpp-options: -D__TYPE_FAMILIES__=1 + if flag(TypeFamilies) + extensions: TypeFamilies + cpp-options: -D__TYPE_FAMILIES__=1 - if flag(Optimize) - ghc-options: -funbox-strict-fields -O2 + if flag(Optimize) + ghc-options: -funbox-strict-fields -O2 diff --git a/src/Control/Allegory.hs b/src/Control/Allegory.hs new file mode 100644 --- /dev/null +++ b/src/Control/Allegory.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE GADTs #-} +------------------------------------------------------------------------------------------- +-- | +-- Module : Control.Allegory +-- Copyright : 2008 Edward Kmett +-- License : BSD +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : portable +-- +-- Allegories are generalizations of categories to cover relations. +------------------------------------------------------------------------------------------- +module Control.Allegory where + +import Prelude hiding (id,(.),all) +import Control.Category +import Control.Functor.Categorical +infix 5 .<=. + +{- + An allegory is a category in which every arrow has a partial ordering, meet and converse such that: + converse f . converse g = converse (f . g) + f .<=. converse g = converse f .<=. g + + Allegories are to relations what categories are to functions +-} +class Category k => Allegory k where + (.<=.) :: k a b -> k a b -> Bool + meet :: k a b -> k a b -> k a b + converse :: k a b -> k b a + + isSimple :: k a b -> Bool + isSimple r = r . converse r .<=. id + + isTotal :: k a b -> Bool + isTotal r = id .<=. converse r . r + + isMap :: k a b -> Bool + isMap r = isSimple r && isTotal r + +class Allegory k => TabulatedAllegory k f where + tabulateLeft :: k a b -> k a (f a b) + tabulateRight :: k a b -> k b (f a b) + +class Allegory k => UnitalAllegory k i | k -> i where + -- unit of the allegory + all :: k a i + + rightDomain :: k b a -> k b b + rightDomain f = converse all . all . f + + leftDomain :: k b a -> k a a + leftDomain f = f . converse all . all + +class (Allegory k1, Allegory k2, CFunctor f k1 k2) => Relator f k1 k2 + +data Map k a b = Map { runMap :: k a b } + +-- the sub-category of maps in an Allegory +instance Allegory k => Category (Map k) where + id = Map id + Map f . Map g = Map (f . g) + +extractMap :: Allegory k => k a b -> Maybe (Map k a b) +extractMap f = if isMap f then Just (Map f) else Nothing diff --git a/src/Control/Comonad.hs b/src/Control/Comonad.hs --- a/src/Control/Comonad.hs +++ b/src/Control/Comonad.hs @@ -25,6 +25,7 @@ , sequenceW ) where +import Data.Monoid import Control.Monad.Identity import Control.Functor.Pointed @@ -61,6 +62,14 @@ and the third is the definition of 'liftW'.) -} +-- class Functor w => Extendable w where +-- duplicate :: w a -> w (w a) +-- extend :: (w a -> b) -> w a -> w b +-- extend f = fmap f . duplicate +-- duplicate = extend id +-- class (Copointed w, Extendable w) => Comonad w +-- instance (Copointed w, Extendable w) => Comonad w + class Copointed w => Comonad w where duplicate :: w a -> w (w a) extend :: (w a -> b) -> w a -> w b @@ -106,3 +115,9 @@ instance Comonad ((,)e) where duplicate ~(e,a) = (e,(e,a)) +-- the anonymous exponent comonad +instance Monoid m => Copointed ((->)m) where + extract f = f mempty + +instance Monoid m => Comonad ((->)m) where + duplicate f m = f . mappend m diff --git a/src/Control/Comonad/Exponent.hs b/src/Control/Comonad/Exponent.hs new file mode 100644 --- /dev/null +++ b/src/Control/Comonad/Exponent.hs @@ -0,0 +1,29 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Comonad.Exponent +-- Copyright : (C) 2008 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : portable +-- +---------------------------------------------------------------------------- +module Control.Comonad.Exponent + ( Exp(..) + ) where + +import Data.Monoid +import Control.Comonad + +data Exp m a = Exp { runExp :: m -> a } + +instance Functor (Exp m) where + fmap f (Exp g) = Exp (f . g) + +instance Monoid m => Copointed (Exp m) where + extract (Exp f) = f mempty + +instance Monoid m => Comonad (Exp m) where + duplicate f = Exp $ \m -> Exp $ runExp f . mappend m + diff --git a/src/Control/Dyad.hs b/src/Control/Dyad.hs new file mode 100644 --- /dev/null +++ b/src/Control/Dyad.hs @@ -0,0 +1,35 @@ +{-# OPTIONS_GHC -cpp #-} +------------------------------------------------------------------------------------------- +-- | +-- Module : Control.Dyad +-- Copyright : 2008 Edward Kmett +-- License : BSD3 +-- +-- Maintainer : Edward Kmett +-- Stability : experimental +-- Portability : portable +-- +-- Working Towards Maarten Fokkinga's Dyads +------------------------------------------------------------------------------------------- + +module Control.Dyad where + +import Prelude hiding (id,(.)) +import Control.Category +import Control.Functor.Categorical + +class (CDistributes w m (~>), CDistributes m w (~>), CExtend w (~>), CBind m (~>)) => CDyad w m (~>) where + cdyid :: w a ~> m a + +newtype DiKleisli w m (~>) a b = DiKleisli { runDiKleisli :: w a ~> m b } + +-- instance CMonad m k => CFunctor (DiKleisli w m k a) k k where +-- cmap f (DiKleisli x) = DiKleisli (cmap f . x) + +-- instance CMonad m k => QFunctor (DiKleisli w m k) k k where second g = +-- instance CComonad w k => PFunctor (DiKleisli w m k) (Dual k) k where first f = +-- instance (CMonad m k, CComonad w k) => Bifunctor (DiKleisli w m k) (Dual Hask) Hask Hask where bimap f g + +instance CDyad w m k => Category (DiKleisli w m k) where + DiKleisli f . DiKleisli g = DiKleisli (cbind f . cdist . cextend g) + id = DiKleisli cdyid diff --git a/src/Control/Functor.hs b/src/Control/Functor.hs --- a/src/Control/Functor.hs +++ b/src/Control/Functor.hs @@ -14,10 +14,12 @@ ( PFunctor (first), first' , QFunctor (second), second' , Bifunctor (bimap) + , dimap ) where import Prelude hiding (id,(.)) import Control.Category +import Control.Category.Dual import Control.Category.Hask class (Category r, Category t) => PFunctor p r t | p r -> t, p t -> r where @@ -58,3 +60,7 @@ class (PFunctor p r t, QFunctor p s t) => Bifunctor p r s t | p r -> s t, p s -> r t, p t -> r s where bimap :: r a b -> s c d -> t (p a c) (p b d) + +-- map for difunctors +dimap :: Bifunctor f (Dual k) k k => k b a -> k c d -> k (f a c) (f b d) +dimap f = bimap (Dual f) diff --git a/src/Control/Functor/Algebra.hs b/src/Control/Functor/Algebra.hs --- a/src/Control/Functor/Algebra.hs +++ b/src/Control/Functor/Algebra.hs @@ -31,11 +31,7 @@ import Control.Functor.Extras import Control.Functor.Combinators.Lift --- | F,G-dialgebras generalize algebras and coalgebraas -type Dialgebra f g a = f a -> g a -type GDialgebra f g w m a = f (w a) -> g (m a) - -- | F-G-bialgebras are representable by @DiAlg (f :+: Identity) (Identity :+: g) a@ -- and so add no expressive power, but are a lot more convenient. type Bialgebra f g a = (Algebra f a, Coalgebra g a) @@ -75,3 +71,8 @@ fromBialgebra :: Bialgebra f g :~> Dialgebra (f :*: Identity) (Identity :*: g) fromBialgebra (phi,psi) = Lift . bimap (Identity . phi) (psi . runIdentity) . runLift + +-- | F,G-dialgebras generalize algebras and coalgebras +-- NB: these definitions are actually wrong. +type Dialgebra f g a = f a -> g a +type GDialgebra f g w m a = f (w a) -> g (m a) diff --git a/src/Control/Functor/Categorical.hs b/src/Control/Functor/Categorical.hs --- a/src/Control/Functor/Categorical.hs +++ b/src/Control/Functor/Categorical.hs @@ -12,6 +12,13 @@ ------------------------------------------------------------------------------------------- module Control.Functor.Categorical ( CFunctor (cmap) + , CPointed (creturn) + , CCopointed (cextract) + , CBind (cbind, cjoin) + , CExtend (cextend, cduplicate) + , CDistributes (cdist) + , CMonad + , CComonad ) where import Prelude hiding (id,(.)) @@ -62,3 +69,32 @@ instance Monad m => CFunctor (SS.StateT s m) Hask Hask where cmap = fmap instance Monad m => CFunctor (SRWS.RWST r w s m) Hask Hask where cmap = fmap #endif + +class CFunctor m (~>) (~>) => CBind m (~>) where + cjoin :: m (m a) ~> m a + cbind :: (a ~> m b) -> (m a ~> m b) + + cjoin = cbind id + cbind f = cjoin . cmap f + +class CFunctor w (~>) (~>) => CExtend w (~>) where + cduplicate :: w a ~> w (w a) + cextend :: (w a ~> b) -> (w a ~> w b) + + cduplicate = cextend id + cextend f = cmap f . cduplicate + +class CFunctor m (~>) (~>) => CPointed m (~>) where + creturn :: a ~> m a + +class CFunctor w (~>) (~>) => CCopointed w (~>) where + cextract :: w a ~> a + +class (CFunctor f (~>) (~>), CFunctor g (~>) (~>)) => CDistributes f g (~>) where + cdist :: f (g a) ~> g (f a) + +class (CPointed m (~>), CBind m (~>)) => CMonad m (~>) +instance (CPointed m (~>), CBind m (~>)) => CMonad m (~>) + +class (CCopointed m (~>), CExtend m (~>)) => CComonad m (~>) +instance (CCopointed m (~>), CExtend m (~>)) => CComonad m (~>) diff --git a/src/Control/Functor/Fix.hs b/src/Control/Functor/Fix.hs --- a/src/Control/Functor/Fix.hs +++ b/src/Control/Functor/Fix.hs @@ -20,11 +20,15 @@ , Fix(InB,outB) , identityBialgebraB , paugment, pcoaugment + -- Final and initial dialgebras + -- , NuD(..) + -- , MuD(..) ) where import Control.Monad import Control.Comonad import Control.Functor.Algebra +import Control.Functor.Limit import Control.Monad.Parameterized import Control.Comonad.Parameterized import Control.Comonad @@ -70,3 +74,29 @@ pcoaugment :: PComonad f => ((Fix f a -> f b (Fix f a)) -> Fix f b) -> (Fix f a -> b) -> Fix f b pcoaugment g k = g (pextend (k . InB) . outB) +{- +-- data NuF f = forall a. NuF (a -> f a) a +-- data NuB f b = forall b. NuF (a -> f b a) a +-- data NuDT f g a b = NuDT (f a -> g b) b +-- type NuD f g = Coend (NuDT f g) +data NuD f g = forall a. NuD (f a -> g a) a +outD :: (Functor f, Functor g) => NuD f g -> Colimit f -> g (NuD f g) +outD (NuD f a) (Colim bs) = fmap (NuD f) (f (fmap (const a) bs)) + +outD :: (Functor f, Functor g) => f (NuD f g) -> g (NuD f g) + + +diana :: (f a -> g a) -> a -> NuD f g +diana = NuD + +-- newtype MuF f g = MuF (forall a. (f a -> a) -> a) +-- newtype MuDT f g a b = MuDT ((f b -> g a) -> b) +-- type NuD f g = End (MuDT f g) +newtype MuD f g = MuD (forall a. (f a -> g a) -> a) +inD :: f (MuD f g) -> g (MuD f g) +inD +inD :: MuD f g -> Limit f -> g (MuD f g) + +dicata :: (f a -> g a) -> MuD f g -> a +dicata = MuD +-} diff --git a/src/Control/Monad/Categorical.hs b/src/Control/Monad/Categorical.hs --- a/src/Control/Monad/Categorical.hs +++ b/src/Control/Monad/Categorical.hs @@ -1,17 +1,5 @@ -module Control.Monad.Categorical where +module Control.Monad.Categorical + (CMonad, CBind(..), CPointed(..)) where + import Prelude hiding (id,(.)) -import Control.Category import Control.Functor.Categorical - -class CFunctor m c d => CPointed m c d where - creturn :: d a (m a) - --- class CPointed m (~>) => CApplicative m (~>) where --- cap :: m (a ~> b) ~> m a ~> m b - -class CPointed m (~>) (~>) => CMonad m (~>) where - cbind :: (a ~> m b) -> m a ~> m b - cjoin :: m (m a) ~> m a - - cbind f = cjoin . cmap f - cjoin = cbind id diff --git a/src/Control/Morphism/Prepro.hs b/src/Control/Morphism/Prepro.hs --- a/src/Control/Morphism/Prepro.hs +++ b/src/Control/Morphism/Prepro.hs @@ -28,13 +28,16 @@ import Control.Morphism.Cata -- | @cascade f . map f = map f . cascade f@ --- | @cascade f = biprepro InB (first f)@ --- | @cascade f = x where x = InB . bimap id (x . fmap f) . outB@ --- | @cascade f = x where x = InB . bimap id (fmap f . x) . outB@ +-- +-- @cascade f = biprepro InB (first f)@ +-- +-- @cascade f = x where x = InB . bimap id (x . fmap f) . outB@ +-- +-- @cascade f = x where x = InB . bimap id (fmap f . x) . outB@ + +-- @cascade f = biprepro InB (first f)@ cascade :: Bifunctor s Hask Hask Hask => (a -> a) -> Fix s a -> Fix s a --- cascade f = biprepro InB (first f) cascade f = x where x = InB . bimap id (x . fmap f) . outB --- equivalently: @cascade f = InB . bimap id (fmap f . cascade f) . outB@ -- | Fokkinga's Prepromorphism prepro :: Functor f => Algebra f c -> (f :~> f) -> FixF f -> c