summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorConalElliott <>2011-12-01 21:47:27 (GMT)
committerhdiff <hdiff@luite.com>2011-12-01 21:47:27 (GMT)
commitc78ec9d560cdc8d1bea8936125fb11caadc32195 (patch)
tree30729a5e5475878536112fb23f2c9799cfd41fd4
parentb5fb814c9eda7791696716368eb6259959af1e0a (diff)
version 0.9.00.9.0
-rw-r--r--TypeCompose.cabal4
-rw-r--r--src/Control/Compose.hs107
-rw-r--r--src/Data/Pair.hs6
-rw-r--r--src/Data/Zip.hs2
4 files changed, 76 insertions, 43 deletions
diff --git a/TypeCompose.cabal b/TypeCompose.cabal
index 233e359..ea0e82f 100644
--- a/TypeCompose.cabal
+++ b/TypeCompose.cabal
@@ -1,5 +1,5 @@
Name: TypeCompose
-Version: 0.8.3
+Version: 0.9.0
Synopsis: Type composition classes & instances
Category: Composition, Control
Description:
@@ -8,7 +8,7 @@ Description:
.
Please see the project wiki page: <http://haskell.org/haskellwiki/TypeCompose>
.
- &#169; 2007-2010 by Conal Elliott; BSD3 license.
+ &#169; 2007-2011 by Conal Elliott; BSD3 license.
Author: Conal Elliott
Maintainer: conal@conal.net
Homepage: http://haskell.org/haskellwiki/TypeCompose
diff --git a/src/Control/Compose.hs b/src/Control/Compose.hs
index e573980..ea2ed05 100644
--- a/src/Control/Compose.hs
+++ b/src/Control/Compose.hs
@@ -31,11 +31,11 @@ module Control.Compose
-- * Specialized semantic editor combinators
, result, argument, (~>), (~>*)
-- * Contravariant functors
- , Cofunctor(..), bicomap
+ , ContraFunctor(..), bicomap
-- * Unary\/unary composition
, (:.)(..), O, unO, biO, convO, coconvO, inO, inO2, inO3
, oPure, oFmap, oLiftA2, oLiftA3
- , fmapFF, fmapCC, cofmapFC, cofmapCF
+ , fmapFF, fmapCC, contraFmapFC, contraFmapCF
-- , DistribM(..), joinMM
-- * Type composition
-- ** Unary\/binary
@@ -140,12 +140,12 @@ f ~>* g = fmap f ~> fmap g
-- | Contravariant functors. often useful for /acceptors/ (consumers,
-- sinks) of values.
-class Cofunctor acc where
- cofmap :: (a -> b) -> (acc b -> acc a)
+class ContraFunctor h where
+ contraFmap :: (a -> b) -> (h b -> h a)
-- | Bijections on contravariant functors
-bicomap :: Cofunctor f => (a :<->: b) -> (f a :<->: f b)
-bicomap (Bi ab ba) = Bi (cofmap ba) (cofmap ab)
+bicomap :: ContraFunctor f => (a :<->: b) -> (f a :<->: f b)
+bicomap (Bi ab ba) = Bi (contraFmap ba) (contraFmap ab)
{----------------------------------------------------------
@@ -174,13 +174,13 @@ Corresponding to the first and second definitions above,
> { mempty_f = O mempty_f; mappend_f = inO2 mappend_f }
Similarly, there are two useful 'Functor' instances and two useful
-'Cofunctor' instances.
+'ContraFunctor' instances.
-> instance ( Functor g, Functor f) => Functor (g :. f) where fmap = fmapFF
-> instance (Cofunctor g, Cofunctor f) => Functor (g :. f) where fmap = fmapCC
+> instance ( Functor g, Functor f) => Functor (g :. f) where fmap = fmapFF
+> instance (ContraFunctor g, ContraFunctor f) => Functor (g :. f) where fmap = fmapCC
>
-> instance (Functor g, Cofunctor f) => Cofunctor (g :. f) where cofmap = cofmapFC
-> instance (Cofunctor g, Functor f) => Cofunctor (g :. f) where cofmap = cofmapCF
+> instance ( Functor g, ContraFunctor f) => ContraFunctor (g :. f) where contraFmap = contraFmapFC
+> instance (ContraFunctor g, Functor f) => ContraFunctor (g :. f) where contraFmap = contraFmapCF
However, it's such a bother to define the Functor instances per
composition type, I've left the fmapFF case in. If you want the fmapCC
@@ -211,12 +211,29 @@ instance (Functor g, Functor f) => Functor (g :. f) where fmap = fmapFF
-- These next two instances are based on suggestions from Creighton Hogg:
instance (Foldable g, Foldable f, Functor g) => Foldable (g :. f) where
- foldMap f = fold . fmap (foldMap f) . unO
+ -- foldMap f = fold . fmap (foldMap f) . unO
+ foldMap f = foldMap (foldMap f) . unO
+ -- fold (O gfa) = fold (fold <$> gfa)
+ -- fold = fold . fmap fold . unO
+ fold = foldMap fold . unO
+ -- I could let fold default
instance (Traversable g, Traversable f) => Traversable (g :. f) where
- sequenceA = fmap O . sequenceA . fmap sequenceA . unO
-
-
+ -- sequenceA = fmap O . sequenceA . fmap sequenceA . unO
+ -- sequenceA = fmap O . traverse sequenceA . unO
+ -- sequenceA = (unO ~> fmap O) (traverse sequenceA)
+ -- traverse f = fmap O . traverse (traverse f) . unO
+ traverse = (unO ~> fmap O) . traverse . traverse
+
+-- traverse f
+-- sequenceA . fmap f
+-- sequenceA . (inO.fmap.fmap) f
+-- sequenceA . inO (fmap (fmap f))
+-- sequenceA . O . fmap (fmap f) . unO
+-- fmap O . traverse sequenceA . unO . O . fmap (fmap f) . unO
+-- fmap O . traverse sequenceA . fmap (fmap f) . unO
+-- fmap O . traverse (sequenceA . fmap f) . unO
+-- fmap O . traverse (traverse f) . unO
-- instance (Functor g, Functor f) => Functor (g :. f) where
-- fmap = inO.fmap.fmap
@@ -229,8 +246,8 @@ biO = Bi O unO
convO :: Functor g => (b :<->: g c) -> (c :<->: f a) -> (b :<->: (g :. f) a)
convO biG biF = biG >>> bimap biF >>> Bi O unO
--- | Compose a bijection, Cofunctor style
-coconvO :: Cofunctor g => (b :<->: g c) -> (c :<->: f a) -> (b :<->: (g :. f) a)
+-- | Compose a bijection, ContraFunctor style
+coconvO :: ContraFunctor g => (b :<->: g c) -> (c :<->: f a) -> (b :<->: (g :. f) a)
coconvO biG biF = biG >>> bicomap biF >>> Bi O unO
@@ -280,19 +297,19 @@ oLiftA3 = inO3 . liftA3
fmapFF :: ( Functor g, Functor f) => (a -> b) -> (g :. f) a -> (g :. f) b
fmapFF = inO.fmap.fmap
--- | Used for the @Cofunctor :. Cofunctor@ instance of 'Functor'
-fmapCC :: (Cofunctor g, Cofunctor f) => (a -> b) -> (g :. f) a -> (g :. f) b
-fmapCC = inO.cofmap.cofmap
+-- | Used for the @ContraFunctor :. ContraFunctor@ instance of 'Functor'
+fmapCC :: (ContraFunctor g, ContraFunctor f) => (a -> b) -> (g :. f) a -> (g :. f) b
+fmapCC = inO.contraFmap.contraFmap
--- | Used for the @Functor :. Cofunctor@ instance of 'Functor'
-cofmapFC :: (Functor g, Cofunctor f) => (b -> a) -> (g :. f) a -> (g :. f) b
-cofmapFC = inO.fmap.cofmap
+-- | Used for the @Functor :. ContraFunctor@ instance of 'Functor'
+contraFmapFC :: (Functor g, ContraFunctor f) => (b -> a) -> (g :. f) a -> (g :. f) b
+contraFmapFC = inO.fmap.contraFmap
--- cofmapFC h (O gf) = O (fmap (cofmap h) gf)
+-- contraFmapFC h (O gf) = O (fmap (contraFmap h) gf)
--- | Used for the @Cofunctor :. Functor@ instance of 'Functor'
-cofmapCF :: (Cofunctor g, Functor f) => (b -> a) -> (g :. f) a -> (g :. f) b
-cofmapCF h (O gf) = O (cofmap (fmap h) gf)
+-- | Used for the @ContraFunctor :. Functor@ instance of 'Functor'
+contraFmapCF :: (ContraFunctor g, Functor f) => (b -> a) -> (g :. f) a -> (g :. f) b
+contraFmapCF h (O gf) = O (contraFmap (fmap h) gf)
instance (Applicative g, Applicative f) => Applicative (g :. f) where
pure = O . pure . pure
@@ -522,8 +539,8 @@ inFlip3 :: ((a~>b) -> (a' ~~> b') -> (a'' ~~~> b'') -> (a''' ~~~~> b'''))
-> (Flip (~>) b a -> Flip (~~>) b' a' -> Flip (~~~>) b'' a'' -> Flip (~~~~>) b''' a''')
inFlip3 f (Flip ar) = inFlip2 (f ar)
-instance Arrow (~>) => Cofunctor (Flip (~>) b) where
- cofmap h (Flip f) = Flip (arr h >>> f)
+instance Arrow (~>) => ContraFunctor (Flip (~>) b) where
+ contraFmap h (Flip f) = Flip (arr h >>> f)
-- Useful for (~>) = (->). Maybe others.
instance (Applicative ((~>) a), Monoid o) => Monoid (Flip (~>) o a) where
@@ -534,7 +551,7 @@ instance (Applicative ((~>) a), Monoid o) => Monoid (Flip (~>) o a) where
instance Monoid o => Monoid_f (Flip (->) o) where
{ mempty_f = mempty ; mappend_f = mappend }
--- | (-> IO ()) as a 'Flip'. A Cofunctor.
+-- | (-> IO ()) as a 'Flip'. A ContraFunctor.
type OI = Flip (->) (IO ())
-- | Convert to an 'OI'.
@@ -583,7 +600,7 @@ instance (Applicative f, Monoid m) => Monoid (App f m) where
{----------------------------------------------------------
- Identity -- TODO: eliminate in favor of Data.Traversable.Id
+ Identity
----------------------------------------------------------}
-- | Identity type constructor. Until there's a better place to find it.
@@ -618,6 +635,22 @@ instance Applicative Id where
pure = Id
(<*>) = inId2 ($)
+instance Monad Id where
+ return = pure
+ Id x >>= f = f x
+
+instance Foldable Id where
+ foldMap f (Id a) = f a
+ -- foldMap f = f . unId
+ -- foldMap = (. unId)
+
+instance Traversable Id where
+ sequenceA (Id fa) = fmap Id fa
+
+-- Id fa :: Id (f a)
+-- fa :: f a
+-- fmap Id fa = f (Id a)
+
{----------------------------------------------------------
Unary constructor pairing
----------------------------------------------------------}
@@ -775,18 +808,18 @@ inArrw3 :: ((f a ~> g a) -> (f' a' ~> g' a') -> (f'' a'' ~> g'' a'') -> (f''' a'
-> ((Arrw (~>) f g) a -> (Arrw (~>) f' g') a' -> (Arrw (~>) f'' g'') a'' -> (Arrw (~>) f''' g''') a''')
inArrw3 h (Arrw p) = inArrw2 (h p)
--- Functor & Cofunctor instances. Beware use of 'arr', which is not
+-- Functor & ContraFunctor instances. Beware use of 'arr', which is not
-- available for some of my favorite arrows.
-instance (Arrow (~>), Cofunctor f, Functor g) => Functor (Arrw (~>) f g) where
- fmap h = inArrw $ \ fga -> arr (cofmap h) >>> fga >>> arr (fmap h)
+instance (Arrow (~>), ContraFunctor f, Functor g) => Functor (Arrw (~>) f g) where
+ fmap h = inArrw $ \ fga -> arr (contraFmap h) >>> fga >>> arr (fmap h)
-instance (Arrow (~>), Functor f, Cofunctor g) => Cofunctor (Arrw (~>) f g) where
- cofmap h = inArrw $ \ fga -> arr (fmap h) >>> fga >>> arr (cofmap h)
+instance (Arrow (~>), Functor f, ContraFunctor g) => ContraFunctor (Arrw (~>) f g) where
+ contraFmap h = inArrw $ \ fga -> arr (fmap h) >>> fga >>> arr (contraFmap h)
-- Restated,
--
--- cofmap h = inArrw $ (arr (fmap h) >>>) . (>>> arr (cofmap h))
+-- contraFmap h = inArrw $ (arr (fmap h) >>>) . (>>> arr (contraFmap h))
-- 'Arrw' specialized to functions.
type (:->:) = Arrw (->)
diff --git a/src/Data/Pair.hs b/src/Data/Pair.hs
index 8e23a93..b7663f2 100644
--- a/src/Data/Pair.hs
+++ b/src/Data/Pair.hs
@@ -159,11 +159,11 @@ instance Unpair Id where { fsts = fmap fst; snds = fmap snd }
----------------------------------------------------------}
-- | Dual to 'Unpair'.
--- Especially handy for contravariant functors ('Cofunctor') . Use this
+-- Especially handy for contravariant functors ('ContraFunctor') . Use this
-- template (filling in @f@) :
--
--
--- > instance Cofunctor f => Copair f where
+-- > instance ContraFunctor f => Copair f where
-- > { cofsts = cofmap fst ; cosnds = cofmap snd }
class Copair f where
@@ -176,7 +176,7 @@ instance Copair (Const e) where
-- Standard instance for contravariant functors
instance Arrow (~>) => Copair (Flip (~>) o) where
- { cofsts = cofmap fst ; cosnds = cofmap snd }
+ { cofsts = contraFmap fst ; cosnds = contraFmap snd }
instance (Functor h, Copair f) => Copair (h :. f) where
cofsts = inO (fmap cofsts)
diff --git a/src/Data/Zip.hs b/src/Data/Zip.hs
index d52398c..ad77b6c 100644
--- a/src/Data/Zip.hs
+++ b/src/Data/Zip.hs
@@ -207,7 +207,7 @@ instance Cozip (Const e) where
-- Standard instance for contravariant functors
instance Arrow (~>) => Cozip (Flip (~>) o) where
- { cofsts = cofmap fst ; cosnds = cofmap snd }
+ { cofsts = contraFmap fst ; cosnds = contraFmap snd }
instance (Functor h, Cozip f) => Cozip (h :. f) where
cofsts = inO (fmap cofsts)