bifunctors 3.0.1 → 3.0.2
raw patch · 5 files changed
+74/−19 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- bifunctors.cabal +1/−1
- src/Data/Bifoldable.hs +21/−0
- src/Data/Bifunctor.hs +9/−0
- src/Data/Bifunctor/Apply.hs +5/−0
- src/Data/Bitraversable.hs +38/−18
bifunctors.cabal view
@@ -1,6 +1,6 @@ name: bifunctors category: Data, Functors-version: 3.0.1+version: 3.0.2 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE
src/Data/Bifoldable.hs view
@@ -34,72 +34,93 @@ class Bifoldable p where bifold :: Monoid m => p m m -> m bifold = bifoldMap id id+ {-# INLINE bifold #-} bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty+ {-# INLINE bifoldMap #-} 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+ {-# INLINE bifoldr #-} 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+ {-# INLINE bifoldl #-} instance Bifoldable (,) where bifoldMap f g ~(a, b) = f a `mappend` g b+ {-# INLINE bifoldMap #-} instance Bifoldable Either where bifoldMap f _ (Left a) = f a bifoldMap _ g (Right b) = g b+ {-# INLINE bifoldMap #-} 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+{-# INLINE bifoldr' #-} 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+{-# INLINE bifoldrM #-} 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+{-# INLINE bifoldl' #-} 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+{-# INLINE bifoldlM #-} bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f () bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())+{-# INLINE bitraverse_ #-} bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f () bifor_ t f g = bitraverse_ f g t+{-# INLINE bifor_ #-} bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m () bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ())+{-# INLINE bimapM_ #-} biforM_ :: (Bifoldable t, Monad m) => t a b -> (a -> m c) -> (b -> m d) -> m () biforM_ t f g = bimapM_ f g t+{-# INLINE biforM_ #-} bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () bisequenceA_ = bifoldr (*>) (*>) (pure ())+{-# INLINE bisequenceA_ #-} bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m () bisequence_ = bifoldr (>>) (>>) (return ())+{-# INLINE bisequence_ #-} biList :: Bifoldable t => t a a -> [a] biList = bifoldr (:) (:) []+{-# INLINE biList #-} biconcat :: Bifoldable t => t [a] [a] -> [a] biconcat = bifold+{-# INLINE biconcat #-} biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c] biconcatMap = bifoldMap+{-# INLINE biconcatMap #-} biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biany p q = getAny . bifoldMap (Any . p) (Any . q)+{-# INLINE biany #-} biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biall p q = getAll . bifoldMap (All . p) (All . q)+{-# INLINE biall #-}
src/Data/Bifunctor.hs view
@@ -17,28 +17,37 @@ class Bifunctor p where bimap :: (a -> b) -> (c -> d) -> p a c -> p b d bimap f g = first f . second g+ {-# INLINE bimap #-} first :: (a -> b) -> p a c -> p b c first f = bimap f id+ {-# INLINE first #-} second :: (b -> c) -> p a b -> p a c second = bimap id+ {-# INLINE second #-} instance Bifunctor (,) where bimap f g ~(a, b) = (f a, g b)+ {-# INLINE bimap #-} instance Bifunctor ((,,) x) where bimap f g ~(x, a, b) = (x, f a, g b)+ {-# INLINE bimap #-} instance Bifunctor ((,,,) x y) where bimap f g ~(x, y, a, b) = (x, y, f a, g b)+ {-# INLINE bimap #-} instance Bifunctor ((,,,,) x y z) where bimap f g ~(x, y, z, a, b) = (x, y, z, f a, g b)+ {-# INLINE bimap #-} instance Bifunctor Either where bimap f _ (Left a) = Left (f a) bimap _ g (Right b) = Right (g b)+ {-# INLINE bimap #-} instance Bifunctor Const where bimap f _ (Const a) = Const (f a)+ {-# INLINE bimap #-}
src/Data/Bifunctor/Apply.hs view
@@ -26,6 +26,7 @@ (<<$>>) :: (a -> b) -> a -> b (<<$>>) = id+{-# INLINE (<<$>>) #-} class Bifunctor p => Biapply p where (<<.>>) :: p (a -> b) (c -> d) -> p a c -> p b d@@ -33,13 +34,16 @@ -- | a .> b = const id <$> a <.> b (.>>) :: p a b -> p c d -> p c d a .>> b = bimap (const id) (const id) <<$>> a <<.>> b+ {-# INLINE (.>>) #-} -- | a <. b = const <$> a <.> b (<<.) :: p a b -> p c d -> p a b a <<. b = bimap const const <<$>> a <<.>> b+ {-# INLINE (<<.) #-} (<<..>>) :: Biapply p => p a c -> p (a -> b) (c -> d) -> p b d (<<..>>) = bilift2 (flip id) (flip id)+{-# INLINE (<<..>>) #-} -- | Lift binary functions bilift2 :: Biapply w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f@@ -53,3 +57,4 @@ instance Biapply (,) where (f, g) <<.>> (a, b) = (f a, g b)+ {-# INLINE (<<.>>) #-}
src/Data/Bitraversable.hs view
@@ -27,22 +27,28 @@ 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+ {-# INLINE bitraverse #-} bisequenceA :: Applicative f => t (f a) (f b) -> f (t a b) bisequenceA = bitraverse id id+ {-# INLINE bisequenceA #-} 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)+ {-# INLINE bimapM #-} bisequence :: Monad m => t (m a) (m b) -> m (t a b) bisequence = bimapM id id+ {-# INLINE bisequence #-} instance Bitraversable (,) where bitraverse f g ~(a, b) = (,) <$> f a <*> g b+ {-# INLINE bitraverse #-} instance Bitraversable Either where bitraverse f _ (Left a) = Left <$> f a bitraverse _ g (Right b) = Right <$> g b+ {-# INLINE bitraverse #-} 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@@ -50,53 +56,67 @@ 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+{-# INLINE biforM #-} -- 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)+ fmap f (StateL k) = StateL $ \ s ->+ let (s', v) = k s in (s', f v)+ {-# INLINE fmap #-} 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)+ pure x = StateL (\ s -> (s, x))+ {-# INLINE pure #-}+ StateL kf <*> StateL kv = StateL $ \ s ->+ let (s', f) = kf s+ (s'', v) = kv s'+ in (s'', f v)+ {-# INLINE (<*>) #-} 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+{-# INLINE bimapAccumL #-} -- 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)+ fmap f (StateR k) = StateR $ \ s ->+ let (s', v) = k s in (s', f v)+ {-# INLINE fmap #-} 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)+ pure x = StateR (\ s -> (s, x))+ {-# INLINE pure #-}+ StateR kf <*> StateR kv = StateR $ \ s ->+ let (s', v) = kv s+ (s'', f) = kf s'+ in (s'', f v)+ {-# INLINE (<*>) #-} 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+{-# INLINE bimapAccumR #-} newtype Id a = Id { getId :: a } instance Functor Id where- fmap f (Id x) = Id (f x)+ fmap f (Id x) = Id (f x)+ {-# INLINE fmap #-} instance Applicative Id where- pure = Id- Id f <*> Id x = Id (f x)+ pure = Id+ {-# INLINE pure #-}+ Id f <*> Id x = Id (f x)+ {-# INLINE (<*>) #-} bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d bimapDefault f g = getId . bitraverse (Id . f) (Id . g)+{-# INLINE bimapDefault #-} -bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m +bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)+{-# INLINE bifoldMapDefault #-}