packages feed

bifunctors 0.1.3.3 → 3.0

raw patch · 13 files changed

+416/−415 lines, 13 filesdep ~basedep ~semigroupoidsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, semigroupoids

API changes (from Hackage documentation)

Files

− Data/Bifoldable.hs 
@@ -1,105 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Bifoldable--- Copyright   :  (C) 2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Bifoldable -  ( Bifoldable(..)-  , bifoldr'-  , bifoldrM-  , bifoldl'-  , bifoldlM-  , bitraverse_-  , bifor_-  , bimapM_-  , biforM_-  , bisequenceA_-  , bisequence_-  , biList-  , biconcat-  , biconcatMap-  , biany-  , biall-  ) where--import Control.Applicative-import Data.Monoid--class Bifoldable p where-  bifold :: Monoid m => p m m -> m-  bifold = bifoldMap id id--  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m-  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty--  bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c-  bifoldr f g z t = appEndo (bifoldMap (Endo . f) (Endo . g) t) z--  bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c-  bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f) (Dual . Endo . flip g) t)) z--instance Bifoldable (,) where-  bifoldMap f g (a, b) = f a `mappend` g b--instance Bifoldable Either where-  bifoldMap f _ (Left a) = f a-  bifoldMap _ g (Right b) = g b--bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c-bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where -  f' k x z = k $! f x z-  g' k x z = k $! g x z--bifoldrM :: (Bifoldable t, Monad m) => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c-bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where-  f' k x z = f x z >>= k-  g' k x z = g x z >>= k--bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a-bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where-  f' x k z = k $! f z x -  g' x k z = k $! g z x--bifoldlM :: (Bifoldable t, Monad m) => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a -bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where-  f' x k z = f z x >>= k-  g' x k z = g z x >>= k-  -bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f ()-bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())--bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f ()-bifor_ t f g = bitraverse_ f g t--bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m ()-bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ())--biforM_ :: (Bifoldable t, Monad m) => t a b ->  (a -> m c) -> (b -> m d) -> m ()-biforM_ t f g = bimapM_ f g t--bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()-bisequenceA_ = bifoldr (*>) (*>) (pure ())--bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m ()-bisequence_ = bifoldr (>>) (>>) (return ())--biList :: Bifoldable t => t a a -> [a]-biList = bifoldr (:) (:) []--biconcat :: Bifoldable t => t [a] [a] -> [a]-biconcat = bifold--biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]-biconcatMap = bifoldMap --biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool-biany p q = getAny . bifoldMap (Any . p) (Any . q)--biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool-biall p q = getAll . bifoldMap (All . p) (All . q)
− Data/Bifunctor.hs 
@@ -1,44 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Bifunctor--- Copyright   :  (C) 2008-2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Bifunctor (Bifunctor(..)) where--import Control.Applicative---- | Minimal definition either 'bimap' or 'first' and 'second'-class Bifunctor p where-  bimap :: (a -> b) -> (c -> d) -> p a c -> p b d-  bimap f g = first f . second g--  first :: (a -> b) -> p a c -> p b c-  first f = bimap f id--  second :: (b -> c) -> p a b -> p a c-  second = bimap id --instance Bifunctor (,) where-  bimap f g (a, b) = (f a, g b)--instance Bifunctor ((,,) x) where-  bimap f g (x, a, b) = (x, f a, g b)--instance Bifunctor ((,,,) x y) where-  bimap f g (x, y, a, b) = (x, y, f a, g b)--instance Bifunctor ((,,,,) x y z) where-  bimap f g (x, y, z, a, b) = (x, y, z, f a, g b)--instance Bifunctor Either where-  bimap f _ (Left a) = Left (f a)-  bimap _ g (Right b) = Right (g b)--instance Bifunctor Const where-  bimap f _ (Const a) = Const (f a)
− Data/Bifunctor/Apply.hs 
@@ -1,55 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Bifunctor.Apply--- Copyright   :  (C) 2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Bifunctor.Apply (-  -- * Functors-  -- * BiAppliable bifunctors-    Biapply(..)-  , (<<$>>)-  , (<<..>>)-  , bilift2-  , bilift3-  , module Data.Bifunctor-  ) where--import Data.Bifunctor--infixl 4 <<$>>, <<.>>, <<., .>>, <<..>>--(<<$>>) :: (a -> b) -> a -> b-(<<$>>) = id--class Bifunctor p => Biapply p where-  (<<.>>) :: p (a -> b) (c -> d) -> p a c -> p b d--  -- | a .> b = const id <$> a <.> b-  (.>>) :: p a b -> p c d -> p c d-  a .>> b = bimap (const id) (const id) <<$>> a <<.>> b--  -- | a <. b = const <$> a <.> b-  (<<.) :: p a b -> p c d -> p a b-  a <<. b = bimap const const <<$>> a <<.>> b--(<<..>>) :: Biapply p => p a c -> p (a -> b) (c -> d) -> p b d-(<<..>>) = bilift2 (flip id) (flip id)---- | Lift binary functions-bilift2 :: Biapply w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f-bilift2 f g a b = bimap f g <<$>> a <<.>> b-{-# INLINE bilift2 #-}---- | Lift ternary functions-bilift3 :: Biapply w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h-bilift3 f g a b c = bimap f g <<$>> a <<.>> b <<.>> c-{-# INLINE bilift3 #-}--instance Biapply (,) where-  (f, g) <<.>> (a, b) = (f a, g b)
− Data/Bitraversable.hs 
@@ -1,102 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Bitraversable--- Copyright   :  (C) 2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Bitraversable-  ( Bitraversable(..)-  , bifor-  , biforM-  , bimapAccumL-  , bimapAccumR-  , bimapDefault-  , bifoldMapDefault-  ) where--import Control.Applicative-import Data.Monoid-import Data.Bifunctor-import Data.Bifoldable--class (Bifunctor t, Bifoldable t) => Bitraversable t where-  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)-  bitraverse f g = bisequenceA . bimap f g--  bisequenceA :: Applicative f => t (f a) (f b) -> f (t a b)-  bisequenceA = bitraverse id id--  bimapM :: Monad m => (a -> m c) -> (b -> m d) -> t a b -> m (t c d)-  bimapM f g = unwrapMonad . bitraverse (WrapMonad . f) (WrapMonad . g)--  bisequence :: Monad m => t (m a) (m b) -> m (t a b)-  bisequence = bimapM id id--instance Bitraversable (,) where-  bitraverse f g (a, b) = (,) <$> f a <*> g b--instance Bitraversable Either where-  bitraverse f _ (Left a) = Left <$> f a-  bitraverse _ g (Right b) = Right <$> g b--bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)-bifor t f g = bitraverse f g t-{-# INLINE bifor #-}--biforM :: (Bitraversable t, Monad m) =>  t a b -> (a -> m c) -> (b -> m d) -> m (t c d)-biforM t f g = bimapM f g t----- left-to-right state transformer-newtype StateL s a = StateL { runStateL :: s -> (s, a) }--instance Functor (StateL s) where-        fmap f (StateL k) = StateL $ \ s ->-                let (s', v) = k s in (s', f v)--instance Applicative (StateL s) where-        pure x = StateL (\ s -> (s, x))-        StateL kf <*> StateL kv = StateL $ \ s ->-                let (s', f) = kf s-                    (s'', v) = kv s'-                in (s'', f v)--bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)-bimapAccumL f g s t = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s---- right-to-left state transformer-newtype StateR s a = StateR { runStateR :: s -> (s, a) }--instance Functor (StateR s) where-        fmap f (StateR k) = StateR $ \ s ->-                let (s', v) = k s in (s', f v)--instance Applicative (StateR s) where-        pure x = StateR (\ s -> (s, x))-        StateR kf <*> StateR kv = StateR $ \ s ->-                let (s', v) = kv s-                    (s'', f) = kf s'-                in (s'', f v)--bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)-bimapAccumR f g s t = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s--newtype Id a = Id { getId :: a }--instance Functor Id where-        fmap f (Id x) = Id (f x)--instance Applicative Id where-        pure = Id-        Id f <*> Id x = Id (f x)--bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d-bimapDefault f g = getId . bitraverse (Id . f) (Id . g)--bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m -bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)
− Data/Semigroup/Bifoldable.hs 
@@ -1,67 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Foldable--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Semigroup.Bifoldable-  ( Bifoldable1(..)-  , bitraverse1_-  , bifor1_-  , bisequenceA1_-  , bifoldMapDefault1-  ) where--import Prelude hiding (foldr)-import Data.Bifoldable-import Data.Functor.Apply-import Data.Semigroup--class Bifoldable t => Bifoldable1 t where-  bifold1 :: Semigroup m => t m m -> m-  bifold1 = bifoldMap1 id id--  bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m-  bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g)--instance Bifoldable1 Either where-  bifoldMap1 f _ (Left a) = f a-  bifoldMap1 _ g (Right b) = g b--instance Bifoldable1 (,) where-  bifoldMap1 f g (a, b) = f a <> g b--newtype Act f a = Act { getAct :: f a }--instance Apply f => Semigroup (Act f a) where-  Act a <> Act b = Act (a .> b)--instance Functor f => Functor (Act f) where-  fmap f (Act a) = Act (f <$> a)-  b <$ Act a = Act (b <$ a)--bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f ()-bitraverse1_ f g t = getAct (bifoldMap1 (Act . ignore . f) (Act . ignore . g) t)-{-# INLINE bitraverse1_ #-}--bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f ()-bifor1_ t f g = bitraverse1_ f g t -{-# INLINE bifor1_ #-}--ignore :: Functor f => f a -> f ()-ignore = (() <$)--bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f ()-bisequenceA1_ t = getAct (bifoldMap1 (Act . ignore) (Act . ignore) t)-{-# INLINE bisequenceA1_ #-}---- | Usable default for foldMap, but only if you define bifoldMap1 yourself-bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m-bifoldMapDefault1 f g = unwrapMonoid . bifoldMap (WrapMonoid . f) (WrapMonoid . g)-{-# INLINE bifoldMapDefault1 #-}-
− Data/Semigroup/Bitraversable.hs 
@@ -1,39 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Semigroup.Bitraversable--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Semigroup.Bitraversable-  ( Bitraversable1(..)-  , bifoldMap1Default-  ) where--import Control.Applicative-import Data.Functor.Apply-import Data.Semigroup.Bifoldable-import Data.Bitraversable-import Data.Bifunctor-import Data.Semigroup--class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where-  bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d)-  bitraverse1 f g  = bisequence1 . bimap f g--  bisequence1 :: Apply f => t (f a) (f b) -> f (t a b)-  bisequence1 = bitraverse1 id id--bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m-bifoldMap1Default f g = getConst . bitraverse1 (Const . f) (Const . g)--instance Bitraversable1 Either where-  bitraverse1 f _ (Left a) = Left <$> f a-  bitraverse1 _ g (Right b) = Right <$> g b--instance Bitraversable1 (,) where-  bitraverse1 f g (a, b) = (,) <$> f a <.> g b
bifunctors.cabal view
@@ -1,6 +1,6 @@ name:          bifunctors category:      Data, Functors-version:       0.1.3.3+version:       3.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -20,10 +20,11 @@   location: git://github.com/ekmett/bifunctors.git  library+  hs-source-dirs: src   build-depends:-    base          >= 4 && < 5,+    base          == 4.*,     semigroups    >= 0.8.3.1 && < 0.9,-    semigroupoids >= 1.3.1.2 && < 1.4+    semigroupoids == 3.0.*    exposed-modules:     Data.Bifunctor
+ src/Data/Bifoldable.hs view
@@ -0,0 +1,105 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifoldable+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bifoldable +  ( Bifoldable(..)+  , bifoldr'+  , bifoldrM+  , bifoldl'+  , bifoldlM+  , bitraverse_+  , bifor_+  , bimapM_+  , biforM_+  , bisequenceA_+  , bisequence_+  , biList+  , biconcat+  , biconcatMap+  , biany+  , biall+  ) where++import Control.Applicative+import Data.Monoid++class Bifoldable p where+  bifold :: Monoid m => p m m -> m+  bifold = bifoldMap id id++  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m+  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty++  bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c+  bifoldr f g z t = appEndo (bifoldMap (Endo . f) (Endo . g) t) z++  bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c+  bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f) (Dual . Endo . flip g) t)) z++instance Bifoldable (,) where+  bifoldMap f g (a, b) = f a `mappend` g b++instance Bifoldable Either where+  bifoldMap f _ (Left a) = f a+  bifoldMap _ g (Right b) = g b++bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c+bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where +  f' k x z = k $! f x z+  g' k x z = k $! g x z++bifoldrM :: (Bifoldable t, Monad m) => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c+bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where+  f' k x z = f x z >>= k+  g' k x z = g x z >>= k++bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a+bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where+  f' x k z = k $! f z x +  g' x k z = k $! g z x++bifoldlM :: (Bifoldable t, Monad m) => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a +bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where+  f' x k z = f z x >>= k+  g' x k z = g z x >>= k+  +bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f ()+bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())++bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f ()+bifor_ t f g = bitraverse_ f g t++bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m ()+bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ())++biforM_ :: (Bifoldable t, Monad m) => t a b ->  (a -> m c) -> (b -> m d) -> m ()+biforM_ t f g = bimapM_ f g t++bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()+bisequenceA_ = bifoldr (*>) (*>) (pure ())++bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m ()+bisequence_ = bifoldr (>>) (>>) (return ())++biList :: Bifoldable t => t a a -> [a]+biList = bifoldr (:) (:) []++biconcat :: Bifoldable t => t [a] [a] -> [a]+biconcat = bifold++biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]+biconcatMap = bifoldMap ++biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biany p q = getAny . bifoldMap (Any . p) (Any . q)++biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biall p q = getAll . bifoldMap (All . p) (All . q)
+ src/Data/Bifunctor.hs view
@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifunctor+-- Copyright   :  (C) 2008-2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bifunctor (Bifunctor(..)) where++import Control.Applicative++-- | Minimal definition either 'bimap' or 'first' and 'second'+class Bifunctor p where+  bimap :: (a -> b) -> (c -> d) -> p a c -> p b d+  bimap f g = first f . second g++  first :: (a -> b) -> p a c -> p b c+  first f = bimap f id++  second :: (b -> c) -> p a b -> p a c+  second = bimap id ++instance Bifunctor (,) where+  bimap f g (a, b) = (f a, g b)++instance Bifunctor ((,,) x) where+  bimap f g (x, a, b) = (x, f a, g b)++instance Bifunctor ((,,,) x y) where+  bimap f g (x, y, a, b) = (x, y, f a, g b)++instance Bifunctor ((,,,,) x y z) where+  bimap f g (x, y, z, a, b) = (x, y, z, f a, g b)++instance Bifunctor Either where+  bimap f _ (Left a) = Left (f a)+  bimap _ g (Right b) = Right (g b)++instance Bifunctor Const where+  bimap f _ (Const a) = Const (f a)
+ src/Data/Bifunctor/Apply.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifunctor.Apply+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bifunctor.Apply (+  -- * Functors+  -- * BiAppliable bifunctors+    Biapply(..)+  , (<<$>>)+  , (<<..>>)+  , bilift2+  , bilift3+  , module Data.Bifunctor+  ) where++import Data.Bifunctor++infixl 4 <<$>>, <<.>>, <<., .>>, <<..>>++(<<$>>) :: (a -> b) -> a -> b+(<<$>>) = id++class Bifunctor p => Biapply p where+  (<<.>>) :: p (a -> b) (c -> d) -> p a c -> p b d++  -- | a .> b = const id <$> a <.> b+  (.>>) :: p a b -> p c d -> p c d+  a .>> b = bimap (const id) (const id) <<$>> a <<.>> b++  -- | a <. b = const <$> a <.> b+  (<<.) :: p a b -> p c d -> p a b+  a <<. b = bimap const const <<$>> a <<.>> b++(<<..>>) :: Biapply p => p a c -> p (a -> b) (c -> d) -> p b d+(<<..>>) = bilift2 (flip id) (flip id)++-- | Lift binary functions+bilift2 :: Biapply w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f+bilift2 f g a b = bimap f g <<$>> a <<.>> b+{-# INLINE bilift2 #-}++-- | Lift ternary functions+bilift3 :: Biapply w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h+bilift3 f g a b c = bimap f g <<$>> a <<.>> b <<.>> c+{-# INLINE bilift3 #-}++instance Biapply (,) where+  (f, g) <<.>> (a, b) = (f a, g b)
+ src/Data/Bitraversable.hs view
@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bitraversable+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bitraversable+  ( Bitraversable(..)+  , bifor+  , biforM+  , bimapAccumL+  , bimapAccumR+  , bimapDefault+  , bifoldMapDefault+  ) where++import Control.Applicative+import Data.Monoid+import Data.Bifunctor+import Data.Bifoldable++class (Bifunctor t, Bifoldable t) => Bitraversable t where+  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)+  bitraverse f g = bisequenceA . bimap f g++  bisequenceA :: Applicative f => t (f a) (f b) -> f (t a b)+  bisequenceA = bitraverse id id++  bimapM :: Monad m => (a -> m c) -> (b -> m d) -> t a b -> m (t c d)+  bimapM f g = unwrapMonad . bitraverse (WrapMonad . f) (WrapMonad . g)++  bisequence :: Monad m => t (m a) (m b) -> m (t a b)+  bisequence = bimapM id id++instance Bitraversable (,) where+  bitraverse f g (a, b) = (,) <$> f a <*> g b++instance Bitraversable Either where+  bitraverse f _ (Left a) = Left <$> f a+  bitraverse _ g (Right b) = Right <$> g b++bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)+bifor t f g = bitraverse f g t+{-# INLINE bifor #-}++biforM :: (Bitraversable t, Monad m) =>  t a b -> (a -> m c) -> (b -> m d) -> m (t c d)+biforM t f g = bimapM f g t+++-- left-to-right state transformer+newtype StateL s a = StateL { runStateL :: s -> (s, a) }++instance Functor (StateL s) where+        fmap f (StateL k) = StateL $ \ s ->+                let (s', v) = k s in (s', f v)++instance Applicative (StateL s) where+        pure x = StateL (\ s -> (s, x))+        StateL kf <*> StateL kv = StateL $ \ s ->+                let (s', f) = kf s+                    (s'', v) = kv s'+                in (s'', f v)++bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)+bimapAccumL f g s t = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s++-- right-to-left state transformer+newtype StateR s a = StateR { runStateR :: s -> (s, a) }++instance Functor (StateR s) where+        fmap f (StateR k) = StateR $ \ s ->+                let (s', v) = k s in (s', f v)++instance Applicative (StateR s) where+        pure x = StateR (\ s -> (s, x))+        StateR kf <*> StateR kv = StateR $ \ s ->+                let (s', v) = kv s+                    (s'', f) = kf s'+                in (s'', f v)++bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e)+bimapAccumR f g s t = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s++newtype Id a = Id { getId :: a }++instance Functor Id where+        fmap f (Id x) = Id (f x)++instance Applicative Id where+        pure = Id+        Id f <*> Id x = Id (f x)++bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d+bimapDefault f g = getId . bitraverse (Id . f) (Id . g)++bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m +bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)
+ src/Data/Semigroup/Bifoldable.hs view
@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Foldable+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Semigroup.Bifoldable+  ( Bifoldable1(..)+  , bitraverse1_+  , bifor1_+  , bisequenceA1_+  , bifoldMapDefault1+  ) where++import Prelude hiding (foldr)+import Data.Bifoldable+import Data.Functor.Apply+import Data.Semigroup++class Bifoldable t => Bifoldable1 t where+  bifold1 :: Semigroup m => t m m -> m+  bifold1 = bifoldMap1 id id++  bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m+  bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g)++instance Bifoldable1 Either where+  bifoldMap1 f _ (Left a) = f a+  bifoldMap1 _ g (Right b) = g b++instance Bifoldable1 (,) where+  bifoldMap1 f g (a, b) = f a <> g b++newtype Act f a = Act { getAct :: f a }++instance Apply f => Semigroup (Act f a) where+  Act a <> Act b = Act (a .> b)++instance Functor f => Functor (Act f) where+  fmap f (Act a) = Act (f <$> a)+  b <$ Act a = Act (b <$ a)++bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f ()+bitraverse1_ f g t = getAct (bifoldMap1 (Act . ignore . f) (Act . ignore . g) t)+{-# INLINE bitraverse1_ #-}++bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f ()+bifor1_ t f g = bitraverse1_ f g t +{-# INLINE bifor1_ #-}++ignore :: Functor f => f a -> f ()+ignore = (() <$)++bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f ()+bisequenceA1_ t = getAct (bifoldMap1 (Act . ignore) (Act . ignore) t)+{-# INLINE bisequenceA1_ #-}++-- | Usable default for foldMap, but only if you define bifoldMap1 yourself+bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m+bifoldMapDefault1 f g = unwrapMonoid . bifoldMap (WrapMonoid . f) (WrapMonoid . g)+{-# INLINE bifoldMapDefault1 #-}+
+ src/Data/Semigroup/Bitraversable.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Bitraversable+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Semigroup.Bitraversable+  ( Bitraversable1(..)+  , bifoldMap1Default+  ) where++import Control.Applicative+import Data.Functor.Apply+import Data.Semigroup.Bifoldable+import Data.Bitraversable+import Data.Bifunctor+import Data.Semigroup++class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where+  bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d)+  bitraverse1 f g  = bisequence1 . bimap f g++  bisequence1 :: Apply f => t (f a) (f b) -> f (t a b)+  bisequence1 = bitraverse1 id id++bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m+bifoldMap1Default f g = getConst . bitraverse1 (Const . f) (Const . g)++instance Bitraversable1 Either where+  bitraverse1 f _ (Left a) = Left <$> f a+  bitraverse1 _ g (Right b) = Right <$> g b++instance Bitraversable1 (,) where+  bitraverse1 f g (a, b) = (,) <$> f a <.> g b