category-extras 0.51.0 → 0.51.2

raw patch · 5 files changed

+79/−13 lines, 5 filesdep ~ghc

Dependency ranges changed: ghc

Files

• category-extras.cabal +3/−10
• src/Control/Functor.hs +60/−0
• src/Control/Functor/Adjunction.hs +2/−0
• src/Control/Functor/KanExtension.hs +1/−1
• src/Control/Morphism/Universal.hs +13/−2

@@ -1,6 +1,6 @@ name:                   category-extras category:               Control, Monads, Comonads-version:                0.51.0+version:                0.51.2 license:                BSD3 cabal-version:          >= 1.2 license-file:           LICENSE@@ -24,9 +24,6 @@                         its arrows subclass Control.Category.Category         default:        True -flag RedefinableEitherMonad-        description:         Indicates Control.Monad.Error isn't baked into the Prelude- flag TypeFamilies         description:    Support for Type Families is available to us @@ -73,6 +70,7 @@                 Control.Comonad.Pointer,                 Control.Comonad.Reader,                 Control.Comonad.Supply+                Control.Functor,                 Control.Functor.Adjunction,                 Control.Functor.Adjunction.HigherOrder,                 Control.Functor.Algebra,@@ -133,14 +131,9 @@                 build-depends: ghc >= 6.9, base > 3, array                 cpp-options: -D__ARROW_SUBCLASSES_CATEGORY__=1         else-                build-depends: ghc < 6.9, base+                build-depends: ghc < 6.9, base, array                  hs-source-dirs: pre-6.9                 exposed-modules: Control.Category--        if flag(RedefinableEitherMonad)-                build-depends: ghc >= 6.8 -        else-                cpp-options: -D__BROKEN_EITHER__=1          if flag(TypeFamilies)                 extensions: TypeFamilies

@@ -0,0 +1,60 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD3+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-- A more categorical definition of Functor than endofunctors in the category Hask+-------------------------------------------------------------------------------------------+module Control.Functor+	( PFunctor (first), first'+	, QFunctor (second), second'+	, Bifunctor (bimap)+	) where++import Prelude hiding (id,(.))+import Control.Category+import Control.Category.Hask++class (Category r, Category t) => PFunctor p r t | p r -> t, p t -> r where+	first :: r a b -> t (p a c) (p b c)++{-# INLINE first' #-}+first' :: Bifunctor p r s t => r a b -> t (p a c) (p b c)+first' f = bimap f id++class (Category s, Category t) => QFunctor q s t | q s -> t, q t -> s where+	second :: s a b -> t (q c a) (q c b)++{-# INLINE second' #-}+second' :: Bifunctor p r s t => s a b -> t (p c a) (p c b)+second' = bimap id++instance PFunctor Either Hask Hask where+	first = first'++instance QFunctor Either Hask Hask where+	second = second'++instance Bifunctor Either Hask Hask Hask where+        bimap f _ (Left a) = Left (f a)+	bimap _ g (Right a) = Right (g a)++instance QFunctor (->) Hask Hask where+	second = (.)++instance PFunctor (,) Hask Hask where+	first = first'++instance QFunctor (,) Hask Hask where+	second = second'++instance Bifunctor (,) Hask Hask Hask where+        bimap f g ~(a,b)= (f a, g b)++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)

@@ -71,6 +71,8 @@         extend f = compose . fmap (leftAdjunct (f . compose)) . decompose  instance Adjunction ((,)e) ((->)e) where+	leftAdjunct f a e  = f (e,a)+	rightAdjunct f ~(e,a) = f a e 	unit a e = (e,a) 	counit (x,f) = f x 

@@ -31,7 +31,7 @@ 	, adjointToLan, lanToAdjoint 	, composeLan, decomposeLan 	, lanToComposedAdjoint, composedAdjointToLan-	-- * Performance tweaks for (co)free comonads+	-- * Performance tweaks for (co)free (co)monads 	, improveFree 	, worsenCofree 	) where

@@ -14,10 +14,14 @@ -------------------------------------------------------------------------------------------  module Control.Morphism.Universal-	( Couniversal(..), extractCouniversal, universalize-	, Universal(..), extractUniversal, couniversalize+	( Couniversal(..), extractCouniversal, couniversalize+	, couniversalIdentity+	, Universal(..), extractUniversal, universalize+	, universalIdentity 	) where +import Control.Monad.Identity+ data Couniversal a f x = Couniversal (a -> f x) (forall z. (a -> f z) -> x -> z)  extractCouniversal :: Couniversal a f x -> a -> f x@@ -26,6 +30,9 @@ couniversalize :: (a -> f z) -> Couniversal a f x -> x -> z couniversalize f (Couniversal _ s) = s f +couniversalIdentity :: Couniversal a Identity a +couniversalIdentity = Couniversal Identity (runIdentity .)+ data Universal a f x = Universal (f x -> a) (forall z. (f z -> a) -> z -> x)  extractUniversal :: Universal a f x -> f x -> a@@ -33,3 +40,7 @@  universalize :: Universal a f x -> (f z -> a) -> z -> x universalize (Universal _ s) f = s f ++universalIdentity :: Universal a Identity a +universalIdentity = Universal runIdentity (. Identity)+