category 0.2.4.0 → 0.2.4.1
raw patch · 24 files changed
+433/−428 lines, 24 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Control/Categorical/Functor.hs +0/−109
- Control/Categorical/Monad.hs +0/−100
- Control/Category/Const2.hs +0/−15
- Control/Category/Dual.hs +0/−13
- Control/Category/Groupoid.hs +0/−12
- Data/Functor/Trans/Identity.hs +0/−57
- Data/Functor/Trans/Reader.hs +0/−37
- Data/Functor/Trans/Writer.hs +0/−25
- Data/Morphism/Endo.hs +0/−16
- Data/Morphism/Iso.hs +0/−33
- Prelude.hs +0/−9
- Setup.hs +3/−0
- category.cabal +4/−2
- src/Control/Categorical/Functor.hs +109/−0
- src/Control/Categorical/Monad.hs +100/−0
- src/Control/Category/Const2.hs +15/−0
- src/Control/Category/Dual.hs +13/−0
- src/Control/Category/Groupoid.hs +12/−0
- src/Data/Functor/Trans/Identity.hs +57/−0
- src/Data/Functor/Trans/Reader.hs +37/−0
- src/Data/Functor/Trans/Writer.hs +25/−0
- src/Data/Morphism/Endo.hs +16/−0
- src/Data/Morphism/Iso.hs +33/−0
- src/Prelude.hs +9/−0
− Control/Categorical/Functor.hs
@@ -1,109 +0,0 @@-{-# LANGUAGE RankNTypes #-}--module Control.Categorical.Functor where--import Control.Category.Dual-import Control.Category.Groupoid-import qualified Data.Functor as Base-import Data.Functor.Compose-import Data.Functor.Identity-import Data.Functor.Const-import Data.Functor.Product-import Data.Functor.Sum-import Data.Proxy---- | Laws:------ @--- 'map' 'id' = 'id'--- 'map' (f '.' g) = 'map' f '.' 'map' g--- @-class (Category s, Category t) => Functor (s :: α -> α -> *) (t :: β -> β -> *) (f :: α -> β) where- map :: s a b -> t (f a) (f b)--{-# DEPRECATED EndoFunctor "Use Endofunctor" #-}-type EndoFunctor s = Functor s s-type Endofunctor s = Functor s s--infixl 4 <$>-(<$>) :: Functor s (->) f => s a b -> f a -> f b-(<$>) = map--newtype NT s f g = NT { nt :: ∀ a . s (f a) (g a) }--instance Category s => Category (NT s) where- id = NT id- NT f . NT g = NT (f . g)--instance Groupoid s => Groupoid (NT s) where- invert (NT f) = NT (invert f)--instance {-# INCOHERENT #-} Base.Functor f => Functor (->) (->) f where map = Base.fmap--instance Functor s (->) f => Functor (NT s) (NT (->)) (Compose f) where- map (NT f) = NT (\ (Compose x) -> Compose (f <$> x))--instance Functor (NT (->)) (NT (NT (->))) Compose where- map (NT f) = NT (NT (\ (Compose x) -> Compose (f x)))--instance (Functor s (->) f, Functor s (->) g) => Functor s (->) (Sum f g) where- map f (InL x) = InL (f <$> x)- map f (InR y) = InR (f <$> y)--instance Functor (NT (->)) (NT (->)) (Sum f) where- map (NT f) = NT (\ case InL x -> InL x- InR y -> InR (f y))--instance Functor (NT (->)) (NT (NT (->))) Sum where- map (NT f) = NT (NT (\ case InL x -> InL (f x)- InR y -> InR y))--instance (Functor s (->) f, Functor s (->) g) => Functor s (->) (Product f g) where- map f (Pair x y) = Pair (f <$> x) (f <$> y)--instance Functor (NT (->)) (NT (->)) (Product f) where- map (NT f) = NT (\ (Pair x y) -> Pair x (f y))--instance Functor (NT (->)) (NT (NT (->))) Product where- map (NT f) = NT (NT (\ (Pair x y) -> Pair (f x) y))--instance Category s => Functor s (->) (Const a) where- map _ (Const a) = Const a--instance Functor (->) (NT (->)) Const where- map f = NT (\ (Const a) -> Const (f a))--instance Functor (->) (->) Identity where- map f (Identity a) = Identity (f a)--instance Category s => Functor s (->) Proxy where- map _ Proxy = Proxy--instance Functor (->) (->) ((,) a) where- map f (a, b) = (a, f b)--instance Functor (->) (NT (->)) (,) where- map f = NT (\ (a, b) -> (f a, b))--instance Functor (->) (->) (Either a) where- map _ (Left a) = Left a- map f (Right b) = Right (f b)--instance Functor (->) (NT (->)) Either where- map f = NT (\ case Left a -> Left (f a)- Right b -> Right b)--instance Category s => Functor s (->) (s a) where- map = (.)--instance Category s => Functor (Dual s) (NT (->)) s where- map (Dual f) = NT (. f)--instance Functor s t f => Functor (Dual s) (Dual t) f where- map (Dual f) = Dual (map f)--instance (Category t, Functor s (NT t) f) => Functor (Dual s) (NT (Dual t)) f where- map (Dual f) = NT (Dual (nt (map f)))--instance (Category s, Category t, Functor s (NT (Dual t)) f) => Functor s (Dual (NT t)) f where- map f = Dual (NT (dual (nt (map f))))
− Control/Categorical/Monad.hs
@@ -1,100 +0,0 @@-module Control.Categorical.Monad where--import qualified Control.Monad as Base-import Data.Function (($), flip)-import Data.Functor.Identity-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE-import Data.Semigroup (Arg (..))--import Control.Categorical.Functor-import Control.Category.Dual--infixr 1 >=>, <=<, =>=, =<=--class Endofunctor s m => Monad s m where- unit :: a `s` m a-- join :: m (m a) `s` m a- join = bind id-- bind :: a `s` m b -> m a `s` m b- bind f = join . map f--(<=<) :: Monad s m => b `s` m c -> a `s` m b -> a `s` m c-f <=< g = bind f . bind g . unit--(>=>) :: Monad s m => a `s` m b -> b `s` m c -> a `s` m c-(>=>) = flip (<=<)--newtype Kleisli s m a b = Kleisli { kleisli :: a `s` m b }--instance Monad s m => Category (Kleisli s m) where- id = Kleisli unit- Kleisli f . Kleisli g = Kleisli (f <=< g)--instance {-# INCOHERENT #-} Base.Monad m => Monad (->) m where- unit = Base.return- join = Base.join- bind = (Base.=<<)--class Endofunctor s ɯ => Comonad s ɯ where- counit :: ɯ a `s` a-- cut :: ɯ a `s` ɯ (ɯ a)- cut = cobind id-- cobind :: ɯ a `s` b -> ɯ a `s` ɯ b- cobind f = map f . cut--(=<=) :: Comonad s ɯ => ɯ b `s` c -> ɯ a `s` b -> ɯ a `s` c-f =<= g = counit . cobind f . cobind g--(=>=) :: Comonad s ɯ => ɯ a `s` b -> ɯ b `s` c -> ɯ a `s` c-(=>=) = flip (=<=)--newtype Cokleisli s ɯ a b = Cokleisli { cokleisli :: ɯ a `s` b }--instance Comonad s ɯ => Category (Cokleisli s ɯ) where- id = Cokleisli counit- Cokleisli f . Cokleisli g = Cokleisli (f =<= g)--instance Comonad (->) Identity where- counit = runIdentity- cut = map Identity--instance Comonad (->) NonEmpty where- counit = NE.head- cut (x:|xs) = (x:|xs) :| go xs- where go [] = []- go (x:xs) = (x:|xs) : go xs--instance Monoid m => Comonad (->) ((->) m) where- counit = ($ mempty)- cut f x y = f (x <> y)--instance Comonad (->) ((,) a) where- counit (_, b) = b- cut (a, b) = (a, (a, b))--instance Comonad (->) (Arg a) where- counit (Arg _ b) = b- cut (Arg a b) = Arg a (Arg a b)--instance Functor s t m => Functor s (->) (Kleisli t m a) where- map f (Kleisli φ) = Kleisli (map f . φ)--instance Category s => Functor s (->) (Cokleisli s ɯ a) where- map f (Cokleisli φ) = Cokleisli (f . φ)--instance Category s => Functor (Dual s) (NT (->)) (Kleisli s m) where- map (Dual f) = NT (\ (Kleisli φ) -> Kleisli (φ . f))--instance Functor s t ɯ => Functor (Dual s) (NT (->)) (Cokleisli t ɯ) where- map (Dual f) = NT (\ (Cokleisli φ) -> Cokleisli (φ . map f))--instance Monad s m => Functor (Kleisli s m) s m where- map = bind . kleisli--instance Comonad s ɯ => Functor (Cokleisli s ɯ) s ɯ where- map = cobind . cokleisli
− Control/Category/Const2.hs
@@ -1,15 +0,0 @@-module Control.Category.Const2 where--import Algebra as A-import Control.Category.Groupoid---- | Notes: 'Const2' '()' is the indiscrete category.-newtype Const2 a b c = Const2 a- deriving (Semigroup, Monoid, Group)--instance (Semigroup a, Monoid a) => Category (Const2 a) where- id = Const2 mempty- Const2 a . Const2 b = Const2 (a <> b)--instance (Semigroup a, Group a) => Groupoid (Const2 a) where- invert (Const2 a) = Const2 (A.invert a)
− Control/Category/Dual.hs
@@ -1,13 +0,0 @@-module Control.Category.Dual where--import Control.Category.Groupoid--newtype Dual k a b = Dual { dual :: k b a }- deriving (Semigroup, Monoid, Group)--instance Category k => Category (Dual k) where- id = Dual id- Dual f . Dual g = Dual (g . f)--instance Groupoid k => Groupoid (Dual k) where- invert = Dual . invert . dual
− Control/Category/Groupoid.hs
@@ -1,12 +0,0 @@-module Control.Category.Groupoid where---- | 'Category' where every morphism is iso------ Laws:------ @--- 'id' = f '.' 'invert' f--- 'id' = 'invert' f '.' f--- @-class Category k => Groupoid k where- invert :: k a b -> k b a
− Data/Functor/Trans/Identity.hs
@@ -1,57 +0,0 @@-module Data.Functor.Trans.Identity where--import Control.Categorical.Functor-import Control.Categorical.Monad--newtype IdentityT f a = IdentityT { runIdentityT :: f a }--instance Functor (NT (->)) (NT (->)) IdentityT where- map f = NT (\ (IdentityT x) -> IdentityT (nt f x))--instance Monad (->) m => Functor (NT (Kleisli (->) m)) (NT (Kleisli (->) m)) IdentityT where- map f = NT (Kleisli (map IdentityT . kleisli (nt f) . runIdentityT))--instance Comonad (->) ɯ => Functor (NT (Cokleisli (->) ɯ)) (NT (Cokleisli (->) ɯ)) IdentityT where- map f = NT (Cokleisli (IdentityT . cokleisli (nt f) . map runIdentityT))--instance Monad (NT (->)) IdentityT where- unit = NT IdentityT- join = NT runIdentityT--instance Comonad (NT (->)) IdentityT where- counit = NT runIdentityT- cut = NT IdentityT--instance Monad (->) m => Monad (NT (Kleisli (->) m)) IdentityT where- unit = NT (Kleisli (unit . IdentityT))- join = NT (Kleisli (unit . runIdentityT))--instance Comonad (->) ɯ => Monad (NT (Cokleisli (->) ɯ)) IdentityT where- unit = NT (Cokleisli (IdentityT . counit))- join = NT (Cokleisli (runIdentityT . counit))--instance Comonad (->) ɯ => Comonad (NT (Cokleisli (->) ɯ)) IdentityT where- counit = NT (Cokleisli (runIdentityT . counit))- cut = NT (Cokleisli (IdentityT . counit))--instance Monad (->) m => Comonad (NT (Kleisli (->) m)) IdentityT where- counit = NT (Kleisli (unit . runIdentityT))- cut = NT (Kleisli (unit . IdentityT))--deriving instance Functor s (->) f => Functor s (->) (IdentityT f)--instance Monad (->) f => Monad (->) (IdentityT f) where- unit = IdentityT . unit- join = IdentityT . bind runIdentityT . runIdentityT--instance Comonad (->) f => Comonad (->) (IdentityT f) where- counit = counit . runIdentityT- cut = runIdentityT . cobind runIdentityT . IdentityT--instance (Functor s (Kleisli (->) m) f, Endofunctor (->) m) =>- Functor s (Kleisli (->) m) (IdentityT f) where- map f = Kleisli (map IdentityT . kleisli (map f) . runIdentityT)--instance (Functor s (Cokleisli (->) ɯ) f, Endofunctor (->) ɯ) =>- Functor s (Cokleisli (->) ɯ) (IdentityT f) where- map f = Cokleisli (IdentityT . cokleisli (map f) . map runIdentityT)
− Data/Functor/Trans/Reader.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE RankNTypes #-}--module Data.Functor.Trans.Reader where--import Control.Categorical.Functor-import Control.Categorical.Monad-import Data.Function (flip)--newtype ReaderT s r f a = ReaderT { runReaderT :: r `s` f a }--instance {-# INCOHERENT #-} Functor s t f => Functor s (->) (ReaderT t r f) where- map f (ReaderT x) = ReaderT (map f . x)--instance (Functor t (->) f, Functor (->) (->) (s r)) => Functor t (->) (ReaderT s r f) where- map f (ReaderT x) = ReaderT ((map f :: _ -> _) <$> x)--instance Monad (->) f => Monad (->) (ReaderT (->) r f) where- unit = ReaderT . unit . unit- join (ReaderT x) = ReaderT (\ r -> (flip id r >=> flip runReaderT r) x)--instance Comonad (->) ɯ => Comonad (->) (ReaderT (,) r ɯ) where- counit = counit . counit . runReaderT- cut (ReaderT (r, x)) = ReaderT (r, cobind (ReaderT . (,) r) x)--instance (Functor t (->) (s r)) => Functor (NT t) (NT (->)) (ReaderT s r) where- map f = NT (\ (ReaderT x) -> ReaderT (nt f <$> x))--instance Monad (->) (s r) => Monad (NT (->)) (ReaderT s r) where- unit = NT (ReaderT . unit)- join = NT (ReaderT . bind runReaderT . runReaderT)--instance Comonad (->) (s r) => Comonad (NT (->)) (ReaderT s r) where- counit = NT (counit . runReaderT)- cut = NT (ReaderT . cobind ReaderT . runReaderT)--instance Functor t (NT (->)) s => Functor t (NT (NT (->))) (ReaderT s) where- map f = NT (NT (\ (ReaderT x) -> ReaderT (nt (map f) x)))
− Data/Functor/Trans/Writer.hs
@@ -1,25 +0,0 @@-module Data.Functor.Trans.Writer where--import Control.Categorical.Functor-import Control.Categorical.Monad--newtype WriterT p w f a = WriterT { runWriterT :: f (p w a) }--instance (Functor (->) (->) f, Functor s (->) (p w)) => Functor s (->) (WriterT p w f) where- map f (WriterT x) = WriterT ((map f :: _ -> _) <$> x)--instance (Monoid w, Monad (->) f) => Monad (->) (WriterT (,) w f) where- unit = WriterT . unit . unit- join = WriterT . bind (\ (w, WriterT y) -> map (\ (w', a) -> (w <> w', a)) y) . runWriterT--instance (Comonad (->) (p w), Comonad (->) f) => Comonad (->) (WriterT p w f) where- counit = counit . counit . runWriterT- cut = WriterT . cobind (\ x -> (\ _ -> WriterT x) <$> counit x) . runWriterT--instance Monad (->) f => Monad (->) (WriterT Either w f) where- unit = WriterT . unit . unit- join = WriterT . bind (\ case Left w -> unit (Left w)- Right (WriterT x) -> x) . runWriterT--instance Functor (NT (->)) (NT (->)) (WriterT p w) where- map f = NT (\ (WriterT x) -> WriterT (nt f x))
− Data/Morphism/Endo.hs
@@ -1,16 +0,0 @@-module Data.Morphism.Endo where--import Algebra as A-import Control.Category.Groupoid as C--newtype Endo s a = Endo { endo :: s a a }--instance Category s => Semigroup (Endo s a) where- Endo f <> Endo g = Endo (f . g)--instance Category s => Monoid (Endo s a) where- mappend = (<>)- mempty = Endo id--instance Groupoid s => Group (Endo s a) where- invert (Endo f) = Endo (C.invert f)
− Data/Morphism/Iso.hs
@@ -1,33 +0,0 @@-module Data.Morphism.Iso where--import qualified Algebra as A-import Control.Categorical.Functor-import Control.Category.Dual-import Control.Category.Groupoid--data Iso s a b = Iso (s a b) (s b a)--instance (Semigroup (s a b), Semigroup (s b a)) => Semigroup (Iso s a b) where- Iso f f' <> Iso g g' = Iso (f <> g) (f' <> g')--instance (Semigroup (s a b), Semigroup (s b a),- Monoid (s a b), Monoid (s b a)) => Monoid (Iso s a b) where- mappend = (<>)- mempty = Iso mempty mempty--instance (Semigroup (s a b), Semigroup (s b a),- Group (s a b), Group (s b a)) => Group (Iso s a b) where- invert (Iso f f') = Iso (A.invert f) (A.invert f')--instance Category s => Category (Iso s) where- id = Iso id id- Iso f f' . Iso g g' = Iso (f . g) (g' . f')--instance Category s => Groupoid (Iso s) where- invert (Iso f f') = Iso f' f--instance Functor s t f => Functor (Iso s) t f where- map (Iso f _) = map f--instance Functor s t f => Functor (Iso s) (Dual t) f where- map (Iso _ f') = Dual (map f')
− Prelude.hs
@@ -1,9 +0,0 @@-module Prelude (module Control.Category,- module Data.Either,- Semigroup (..), Monoid (..), Group) where--import Algebra (Group)-import Control.Category-import Data.Either-import Data.Monoid (Monoid (..))-import Data.Semigroup (Semigroup (..))
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
category.cabal view
@@ -1,5 +1,5 @@ name: category-version: 0.2.4.0+version: 0.2.4.1 synopsis: Categorical types and classes -- description: license: BSD3@@ -11,9 +11,11 @@ build-type: Simple cabal-version: >=1.10 bug-reports: http://github.com/strake/category.hs/issues-tested-with: GHC ==8.2.2+tested-with: GHC ==8.4.3+ , GHC ==8.6.4 library+ hs-source-dirs: src exposed-modules: Control.Categorical.Functor , Control.Categorical.Monad , Control.Category.Const2
+ src/Control/Categorical/Functor.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE RankNTypes #-}++module Control.Categorical.Functor where++import Control.Category.Dual+import Control.Category.Groupoid+import qualified Data.Functor as Base+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Functor.Const+import Data.Functor.Product+import Data.Functor.Sum+import Data.Proxy++-- | Laws:+--+-- @+-- 'map' 'id' = 'id'+-- 'map' (f '.' g) = 'map' f '.' 'map' g+-- @+class (Category s, Category t) => Functor (s :: α -> α -> *) (t :: β -> β -> *) (f :: α -> β) where+ map :: s a b -> t (f a) (f b)++{-# DEPRECATED EndoFunctor "Use Endofunctor" #-}+type EndoFunctor s = Functor s s+type Endofunctor s = Functor s s++infixl 4 <$>+(<$>) :: Functor s (->) f => s a b -> f a -> f b+(<$>) = map++newtype NT s f g = NT { nt :: ∀ a . s (f a) (g a) }++instance Category s => Category (NT s) where+ id = NT id+ NT f . NT g = NT (f . g)++instance Groupoid s => Groupoid (NT s) where+ invert (NT f) = NT (invert f)++instance {-# INCOHERENT #-} Base.Functor f => Functor (->) (->) f where map = Base.fmap++instance Functor s (->) f => Functor (NT s) (NT (->)) (Compose f) where+ map (NT f) = NT (\ (Compose x) -> Compose (f <$> x))++instance Functor (NT (->)) (NT (NT (->))) Compose where+ map (NT f) = NT (NT (\ (Compose x) -> Compose (f x)))++instance (Functor s (->) f, Functor s (->) g) => Functor s (->) (Sum f g) where+ map f (InL x) = InL (f <$> x)+ map f (InR y) = InR (f <$> y)++instance Functor (NT (->)) (NT (->)) (Sum f) where+ map (NT f) = NT (\ case InL x -> InL x+ InR y -> InR (f y))++instance Functor (NT (->)) (NT (NT (->))) Sum where+ map (NT f) = NT (NT (\ case InL x -> InL (f x)+ InR y -> InR y))++instance (Functor s (->) f, Functor s (->) g) => Functor s (->) (Product f g) where+ map f (Pair x y) = Pair (f <$> x) (f <$> y)++instance Functor (NT (->)) (NT (->)) (Product f) where+ map (NT f) = NT (\ (Pair x y) -> Pair x (f y))++instance Functor (NT (->)) (NT (NT (->))) Product where+ map (NT f) = NT (NT (\ (Pair x y) -> Pair (f x) y))++instance Category s => Functor s (->) (Const a) where+ map _ (Const a) = Const a++instance Functor (->) (NT (->)) Const where+ map f = NT (\ (Const a) -> Const (f a))++instance Functor (->) (->) Identity where+ map f (Identity a) = Identity (f a)++instance Category s => Functor s (->) Proxy where+ map _ Proxy = Proxy++instance Functor (->) (->) ((,) a) where+ map f (a, b) = (a, f b)++instance Functor (->) (NT (->)) (,) where+ map f = NT (\ (a, b) -> (f a, b))++instance Functor (->) (->) (Either a) where+ map _ (Left a) = Left a+ map f (Right b) = Right (f b)++instance Functor (->) (NT (->)) Either where+ map f = NT (\ case Left a -> Left (f a)+ Right b -> Right b)++instance Category s => Functor s (->) (s a) where+ map = (.)++instance Category s => Functor (Dual s) (NT (->)) s where+ map (Dual f) = NT (. f)++instance Functor s t f => Functor (Dual s) (Dual t) f where+ map (Dual f) = Dual (map f)++instance (Category t, Functor s (NT t) f) => Functor (Dual s) (NT (Dual t)) f where+ map (Dual f) = NT (Dual (nt (map f)))++instance (Category s, Category t, Functor s (NT (Dual t)) f) => Functor s (Dual (NT t)) f where+ map f = Dual (NT (dual (nt (map f))))
+ src/Control/Categorical/Monad.hs view
@@ -0,0 +1,100 @@+module Control.Categorical.Monad where++import qualified Control.Monad as Base+import Data.Function (($), flip)+import Data.Functor.Identity+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Semigroup (Arg (..))++import Control.Categorical.Functor+import Control.Category.Dual++infixr 1 >=>, <=<, =>=, =<=++class Endofunctor s m => Monad s m where+ unit :: a `s` m a++ join :: m (m a) `s` m a+ join = bind id++ bind :: a `s` m b -> m a `s` m b+ bind f = join . map f++(<=<) :: Monad s m => b `s` m c -> a `s` m b -> a `s` m c+f <=< g = bind f . bind g . unit++(>=>) :: Monad s m => a `s` m b -> b `s` m c -> a `s` m c+(>=>) = flip (<=<)++newtype Kleisli s m a b = Kleisli { kleisli :: a `s` m b }++instance Monad s m => Category (Kleisli s m) where+ id = Kleisli unit+ Kleisli f . Kleisli g = Kleisli (f <=< g)++instance {-# INCOHERENT #-} Base.Monad m => Monad (->) m where+ unit = Base.return+ join = Base.join+ bind = (Base.=<<)++class Endofunctor s ɯ => Comonad s ɯ where+ counit :: ɯ a `s` a++ cut :: ɯ a `s` ɯ (ɯ a)+ cut = cobind id++ cobind :: ɯ a `s` b -> ɯ a `s` ɯ b+ cobind f = map f . cut++(=<=) :: Comonad s ɯ => ɯ b `s` c -> ɯ a `s` b -> ɯ a `s` c+f =<= g = counit . cobind f . cobind g++(=>=) :: Comonad s ɯ => ɯ a `s` b -> ɯ b `s` c -> ɯ a `s` c+(=>=) = flip (=<=)++newtype Cokleisli s ɯ a b = Cokleisli { cokleisli :: ɯ a `s` b }++instance Comonad s ɯ => Category (Cokleisli s ɯ) where+ id = Cokleisli counit+ Cokleisli f . Cokleisli g = Cokleisli (f =<= g)++instance Comonad (->) Identity where+ counit = runIdentity+ cut = map Identity++instance Comonad (->) NonEmpty where+ counit = NE.head+ cut (x:|xs) = (x:|xs) :| go xs+ where go [] = []+ go (x:xs) = (x:|xs) : go xs++instance Monoid m => Comonad (->) ((->) m) where+ counit = ($ mempty)+ cut f x y = f (x <> y)++instance Comonad (->) ((,) a) where+ counit (_, b) = b+ cut (a, b) = (a, (a, b))++instance Comonad (->) (Arg a) where+ counit (Arg _ b) = b+ cut (Arg a b) = Arg a (Arg a b)++instance Functor s t m => Functor s (->) (Kleisli t m a) where+ map f (Kleisli φ) = Kleisli (map f . φ)++instance Category s => Functor s (->) (Cokleisli s ɯ a) where+ map f (Cokleisli φ) = Cokleisli (f . φ)++instance Category s => Functor (Dual s) (NT (->)) (Kleisli s m) where+ map (Dual f) = NT (\ (Kleisli φ) -> Kleisli (φ . f))++instance Functor s t ɯ => Functor (Dual s) (NT (->)) (Cokleisli t ɯ) where+ map (Dual f) = NT (\ (Cokleisli φ) -> Cokleisli (φ . map f))++instance Monad s m => Functor (Kleisli s m) s m where+ map = bind . kleisli++instance Comonad s ɯ => Functor (Cokleisli s ɯ) s ɯ where+ map = cobind . cokleisli
+ src/Control/Category/Const2.hs view
@@ -0,0 +1,15 @@+module Control.Category.Const2 where++import Algebra as A+import Control.Category.Groupoid++-- | Notes: 'Const2' '()' is the indiscrete category.+newtype Const2 a b c = Const2 a+ deriving (Semigroup, Monoid, Group)++instance (Semigroup a, Monoid a) => Category (Const2 a) where+ id = Const2 mempty+ Const2 a . Const2 b = Const2 (a <> b)++instance (Semigroup a, Group a) => Groupoid (Const2 a) where+ invert (Const2 a) = Const2 (A.invert a)
+ src/Control/Category/Dual.hs view
@@ -0,0 +1,13 @@+module Control.Category.Dual where++import Control.Category.Groupoid++newtype Dual k a b = Dual { dual :: k b a }+ deriving (Semigroup, Monoid, Group)++instance Category k => Category (Dual k) where+ id = Dual id+ Dual f . Dual g = Dual (g . f)++instance Groupoid k => Groupoid (Dual k) where+ invert = Dual . invert . dual
+ src/Control/Category/Groupoid.hs view
@@ -0,0 +1,12 @@+module Control.Category.Groupoid where++-- | 'Category' where every morphism is iso+--+-- Laws:+--+-- @+-- 'id' = f '.' 'invert' f+-- 'id' = 'invert' f '.' f+-- @+class Category k => Groupoid k where+ invert :: k a b -> k b a
+ src/Data/Functor/Trans/Identity.hs view
@@ -0,0 +1,57 @@+module Data.Functor.Trans.Identity where++import Control.Categorical.Functor+import Control.Categorical.Monad++newtype IdentityT f a = IdentityT { runIdentityT :: f a }++instance Functor (NT (->)) (NT (->)) IdentityT where+ map f = NT (\ (IdentityT x) -> IdentityT (nt f x))++instance Monad (->) m => Functor (NT (Kleisli (->) m)) (NT (Kleisli (->) m)) IdentityT where+ map f = NT (Kleisli (map IdentityT . kleisli (nt f) . runIdentityT))++instance Comonad (->) ɯ => Functor (NT (Cokleisli (->) ɯ)) (NT (Cokleisli (->) ɯ)) IdentityT where+ map f = NT (Cokleisli (IdentityT . cokleisli (nt f) . map runIdentityT))++instance Monad (NT (->)) IdentityT where+ unit = NT IdentityT+ join = NT runIdentityT++instance Comonad (NT (->)) IdentityT where+ counit = NT runIdentityT+ cut = NT IdentityT++instance Monad (->) m => Monad (NT (Kleisli (->) m)) IdentityT where+ unit = NT (Kleisli (unit . IdentityT))+ join = NT (Kleisli (unit . runIdentityT))++instance Comonad (->) ɯ => Monad (NT (Cokleisli (->) ɯ)) IdentityT where+ unit = NT (Cokleisli (IdentityT . counit))+ join = NT (Cokleisli (runIdentityT . counit))++instance Comonad (->) ɯ => Comonad (NT (Cokleisli (->) ɯ)) IdentityT where+ counit = NT (Cokleisli (runIdentityT . counit))+ cut = NT (Cokleisli (IdentityT . counit))++instance Monad (->) m => Comonad (NT (Kleisli (->) m)) IdentityT where+ counit = NT (Kleisli (unit . runIdentityT))+ cut = NT (Kleisli (unit . IdentityT))++deriving instance Functor s (->) f => Functor s (->) (IdentityT f)++instance Monad (->) f => Monad (->) (IdentityT f) where+ unit = IdentityT . unit+ join = IdentityT . bind runIdentityT . runIdentityT++instance Comonad (->) f => Comonad (->) (IdentityT f) where+ counit = counit . runIdentityT+ cut = runIdentityT . cobind runIdentityT . IdentityT++instance (Functor s (Kleisli (->) m) f, Endofunctor (->) m) =>+ Functor s (Kleisli (->) m) (IdentityT f) where+ map f = Kleisli (map IdentityT . kleisli (map f) . runIdentityT)++instance (Functor s (Cokleisli (->) ɯ) f, Endofunctor (->) ɯ) =>+ Functor s (Cokleisli (->) ɯ) (IdentityT f) where+ map f = Cokleisli (IdentityT . cokleisli (map f) . map runIdentityT)
+ src/Data/Functor/Trans/Reader.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE RankNTypes #-}++module Data.Functor.Trans.Reader where++import Control.Categorical.Functor+import Control.Categorical.Monad+import Data.Function (flip)++newtype ReaderT s r f a = ReaderT { runReaderT :: r `s` f a }++instance {-# INCOHERENT #-} Functor s t f => Functor s (->) (ReaderT t r f) where+ map f (ReaderT x) = ReaderT (map f . x)++instance (Functor t (->) f, Functor (->) (->) (s r)) => Functor t (->) (ReaderT s r f) where+ map f (ReaderT x) = ReaderT ((map f :: _ -> _) <$> x)++instance Monad (->) f => Monad (->) (ReaderT (->) r f) where+ unit = ReaderT . unit . unit+ join (ReaderT x) = ReaderT (\ r -> (flip id r >=> flip runReaderT r) x)++instance Comonad (->) ɯ => Comonad (->) (ReaderT (,) r ɯ) where+ counit = counit . counit . runReaderT+ cut (ReaderT (r, x)) = ReaderT (r, cobind (ReaderT . (,) r) x)++instance (Functor t (->) (s r)) => Functor (NT t) (NT (->)) (ReaderT s r) where+ map f = NT (\ (ReaderT x) -> ReaderT (nt f <$> x))++instance Monad (->) (s r) => Monad (NT (->)) (ReaderT s r) where+ unit = NT (ReaderT . unit)+ join = NT (ReaderT . bind runReaderT . runReaderT)++instance Comonad (->) (s r) => Comonad (NT (->)) (ReaderT s r) where+ counit = NT (counit . runReaderT)+ cut = NT (ReaderT . cobind ReaderT . runReaderT)++instance Functor t (NT (->)) s => Functor t (NT (NT (->))) (ReaderT s) where+ map f = NT (NT (\ (ReaderT x) -> ReaderT (nt (map f) x)))
+ src/Data/Functor/Trans/Writer.hs view
@@ -0,0 +1,25 @@+module Data.Functor.Trans.Writer where++import Control.Categorical.Functor+import Control.Categorical.Monad++newtype WriterT p w f a = WriterT { runWriterT :: f (p w a) }++instance (Functor (->) (->) f, Functor s (->) (p w)) => Functor s (->) (WriterT p w f) where+ map f (WriterT x) = WriterT ((map f :: _ -> _) <$> x)++instance (Monoid w, Monad (->) f) => Monad (->) (WriterT (,) w f) where+ unit = WriterT . unit . unit+ join = WriterT . bind (\ (w, WriterT y) -> map (\ (w', a) -> (w <> w', a)) y) . runWriterT++instance (Comonad (->) (p w), Comonad (->) f) => Comonad (->) (WriterT p w f) where+ counit = counit . counit . runWriterT+ cut = WriterT . cobind (\ x -> (\ _ -> WriterT x) <$> counit x) . runWriterT++instance Monad (->) f => Monad (->) (WriterT Either w f) where+ unit = WriterT . unit . unit+ join = WriterT . bind (\ case Left w -> unit (Left w)+ Right (WriterT x) -> x) . runWriterT++instance Functor (NT (->)) (NT (->)) (WriterT p w) where+ map f = NT (\ (WriterT x) -> WriterT (nt f x))
+ src/Data/Morphism/Endo.hs view
@@ -0,0 +1,16 @@+module Data.Morphism.Endo where++import Algebra as A+import Control.Category.Groupoid as C++newtype Endo s a = Endo { endo :: s a a }++instance Category s => Semigroup (Endo s a) where+ Endo f <> Endo g = Endo (f . g)++instance Category s => Monoid (Endo s a) where+ mappend = (<>)+ mempty = Endo id++instance Groupoid s => Group (Endo s a) where+ invert (Endo f) = Endo (C.invert f)
+ src/Data/Morphism/Iso.hs view
@@ -0,0 +1,33 @@+module Data.Morphism.Iso where++import qualified Algebra as A+import Control.Categorical.Functor+import Control.Category.Dual+import Control.Category.Groupoid++data Iso s a b = Iso (s a b) (s b a)++instance (Semigroup (s a b), Semigroup (s b a)) => Semigroup (Iso s a b) where+ Iso f f' <> Iso g g' = Iso (f <> g) (f' <> g')++instance (Semigroup (s a b), Semigroup (s b a),+ Monoid (s a b), Monoid (s b a)) => Monoid (Iso s a b) where+ mappend = (<>)+ mempty = Iso mempty mempty++instance (Semigroup (s a b), Semigroup (s b a),+ Group (s a b), Group (s b a)) => Group (Iso s a b) where+ invert (Iso f f') = Iso (A.invert f) (A.invert f')++instance Category s => Category (Iso s) where+ id = Iso id id+ Iso f f' . Iso g g' = Iso (f . g) (g' . f')++instance Category s => Groupoid (Iso s) where+ invert (Iso f f') = Iso f' f++instance Functor s t f => Functor (Iso s) t f where+ map (Iso f _) = map f++instance Functor s t f => Functor (Iso s) (Dual t) f where+ map (Iso _ f') = Dual (map f')
+ src/Prelude.hs view
@@ -0,0 +1,9 @@+module Prelude (module Control.Category,+ module Data.Either,+ Semigroup (..), Monoid (..), Group) where++import Algebra (Group)+import Control.Category+import Data.Either+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup (..))