Hi Christopher, a data type can be an instance of Category only if it has kind * -> * -> *. It must have 2 type parameters so that you could have types like 'cat a a'.
Some simple examples: import Prelude hiding (id, (.)) import Control.Category import Data.Monoid -- See https://en.wikipedia.org/wiki/Opposite_category newtype Op c a b = Op (c b a) instance Category c => Category (Op c) where id = Op id (Op x) . (Op y) = Op (y . x) -- A category whose morphisms are bijections between types. data Iso a b = Iso (a -> b) (b -> a) instance Category Iso where id = Iso id id (Iso f1 g1) . (Iso f2 g2) = Iso (f1 . f2) (g2 . g1) -- A product of two categories forms a new category: data ProductCat c d a b = ProductCat (c a b) (d a b) instance (Category c, Category d) => Category (ProductCat c d) where id = ProductCat id id (ProductCat f g) . (ProductCat f' g') = ProductCat (f . f') (g . g') -- A category constructed from a monoid. It -- ignores the types. Any morphism in this category -- is simply an element of the given monoid. newtype MonoidCat m a b = MonoidCat m instance (Monoid m) => Category (MonoidCat m) where id = MonoidCat mempty MonoidCat x . MonoidCat y = MonoidCat (x `mappend` y) Many interesting categories can be constructed from various monads using Kleisli. For example, Kleisli Maybe is the category of partial functions. Best regards, Petr 2012/12/20 Christopher Howard <christopher.how...@frigidcode.com> > I've perhaps been trying everyones patiences with my noobish CT > questions, but if you'll bear with me a little longer: I happened to > notice that there is in fact a Category class in Haskell base, in > Control.Category: > > quote: > -------- > class Category cat where > > A class for categories. id and (.) must form a monoid. > > Methods > > id :: cat a a > > the identity morphism > > (.) :: cat b c -> cat a b -> cat a c > > morphism composition > -------- > > However, the documentation lists only two instances of Category, > functions (->) and Kleisli Monad. For instruction purposes, could > someone show me an example or two of how to make instances of this > class, perhaps for a few of the common types? My initial thoughts were > something like so: > > code: > -------- > instance Category Integer where > > id = 1 > > (.) = (*) > > -- and > > instance Category [a] where > > id = [] > (.) = (++) > ------- > > But these lead to kind mis-matches. > > -- > frigidcode.com > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe@haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > >
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe