-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Haskell 98 bifunctors -- -- Haskell 98 bifunctors @package bifunctors @version 3.0.3 module Data.Bifoldable class Bifoldable p where bifold = bifoldMap id id bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty bifoldr f g z t = appEndo (bifoldMap (Endo . f) (Endo . g) t) z bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f) (Dual . Endo . flip g) t)) z bifold :: (Bifoldable p, Monoid m) => p m m -> m bifoldMap :: (Bifoldable p, Monoid m) => (a -> m) -> (b -> m) -> p a b -> m bifoldr :: Bifoldable p => (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c bifoldl :: Bifoldable p => (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c bifoldrM :: (Bifoldable t, Monad m) => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c bifoldl' :: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a bifoldlM :: (Bifoldable t, Monad m) => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f () bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f () bimapM_ :: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m () biforM_ :: (Bifoldable t, Monad m) => t a b -> (a -> m c) -> (b -> m d) -> m () bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m () biList :: Bifoldable t => t a a -> [a] biconcat :: Bifoldable t => t [a] [a] -> [a] biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c] biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool instance Bifoldable Either instance Bifoldable (,) module Data.Semigroup.Bifoldable class Bifoldable t => Bifoldable1 t where bifold1 = bifoldMap1 id id bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g) bifold1 :: (Bifoldable1 t, Semigroup m) => t m m -> m bifoldMap1 :: (Bifoldable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f () bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f () bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f () -- | Usable default for foldMap, but only if you define bifoldMap1 yourself bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m instance Functor f => Functor (Act f) instance Apply f => Semigroup (Act f a) instance Bifoldable1 (,) instance Bifoldable1 Either module Data.Bifunctor -- | Minimal definition either bimap or first and -- second class Bifunctor p where bimap f g = first f . second g first f = bimap f id second = bimap id bimap :: Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d first :: Bifunctor p => (a -> b) -> p a c -> p b c second :: Bifunctor p => (b -> c) -> p a b -> p a c instance Bifunctor Const instance Bifunctor Either instance Bifunctor ((,,,,) x y z) instance Bifunctor ((,,,) x y) instance Bifunctor ((,,) x) instance Bifunctor (,) module Data.Bifunctor.Apply class Bifunctor p => Biapply p where a .>> b = bimap (const id) (const id) <<$>> a <<.>> b a <<. b = bimap const const <<$>> a <<.>> b (<<.>>) :: Biapply p => p (a -> b) (c -> d) -> p a c -> p b d (.>>) :: Biapply p => p a b -> p c d -> p c d (<<.) :: Biapply p => p a b -> p c d -> p a b (<<$>>) :: (a -> b) -> a -> b (<<..>>) :: Biapply p => p a c -> p (a -> b) (c -> d) -> p b d -- | Lift binary functions bilift2 :: Biapply w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f -- | 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 instance Biapply (,) module Data.Bitraversable class (Bifunctor t, Bifoldable t) => Bitraversable t where bitraverse f g = bisequenceA . bimap f g bisequenceA = bitraverse id id bimapM f g = unwrapMonad . bitraverse (WrapMonad . f) (WrapMonad . g) bisequence = bimapM id id bitraverse :: (Bitraversable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bimapM :: (Bitraversable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m (t c d) bisequence :: (Bitraversable t, Monad m) => t (m a) (m b) -> m (t a b) bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d) biforM :: (Bitraversable t, Monad m) => t a b -> (a -> m c) -> (b -> m d) -> m (t c d) bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e) bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e) bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m instance Applicative Id instance Functor Id instance Applicative (StateR s) instance Functor (StateR s) instance Applicative (StateL s) instance Functor (StateL s) instance Bitraversable Either instance Bitraversable (,) module Data.Semigroup.Bitraversable class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where bitraverse1 f g = bisequence1 . bimap f g bisequence1 = bitraverse1 id id bitraverse1 :: (Bitraversable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f (t b d) bisequence1 :: (Bitraversable1 t, Apply f) => t (f a) (f b) -> f (t a b) bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m instance Bitraversable1 (,) instance Bitraversable1 Either