-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Haskell 98 bifunctors -- -- Haskell 98 bifunctors @package bifunctors @version 3.2.0.1 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 (Tagged *) instance Bifoldable ((,,,,) x y z) instance Bifoldable ((,,,) x y) instance Bifoldable ((,,) x) instance Bifoldable Const 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 (Tagged *) instance Bifoldable1 Const instance Bifoldable1 ((,,,,) x y z) instance Bifoldable1 ((,,,) x y) instance Bifoldable1 ((,,) x) instance Bifoldable1 (,) instance Bifoldable1 Either module Data.Bifunctor -- | Minimal definition either bimap or first and -- second -- -- Formally, the class Bifunctor represents a bifunctor from -- Hask -> Hask. -- -- Intuitively it is a bifunctor where both the first and second -- arguments are covariant. -- -- You can define a Bifunctor by either defining bimap or -- by defining both first and second. -- -- If you supply bimap, you should ensure that: -- --
--   bimap id idid
--   
-- -- If you supply first and second, ensure: -- --
--   first idid
--   second idid
--   
-- -- If you supply both, you should also ensure: -- --
--   bimap f g ≡ first f . second g
--   
-- -- These ensure by parametricity: -- --
--   bimap  (f . g) (h . i) ≡ bimap f h . bimap g i
--   first  (f . g) ≡ first  f . first  g
--   second (f . g) ≡ second f . second g
--   
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 (Tagged *) 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 (Tagged *) instance Biapply Const instance (Semigroup x, Semigroup y, Semigroup z) => Biapply ((,,,,) x y z) instance (Semigroup x, Semigroup y) => Biapply ((,,,) x y) instance Semigroup x => Biapply ((,,) x) 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 (Tagged *) instance Bitraversable Const instance Bitraversable Either instance Bitraversable ((,,,,) x y z) instance Bitraversable ((,,,) x y) instance Bitraversable ((,,) x) 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 (Tagged *) instance Bitraversable1 Const instance Bitraversable1 ((,,,,) x y z) instance Bitraversable1 ((,,,) x y) instance Bitraversable1 ((,,) x) instance Bitraversable1 (,) instance Bitraversable1 Either module Data.Biapplicative class Bifunctor p => Biapplicative p where a *>> b = bimap (const id) (const id) <<$>> a <<*>> b a <<* b = bimap const const <<$>> a <<*>> b bipure :: Biapplicative p => a -> b -> p a b (<<*>>) :: Biapplicative p => p (a -> b) (c -> d) -> p a c -> p b d (*>>) :: Biapplicative p => p a b -> p c d -> p c d (<<*) :: Biapplicative p => p a b -> p c d -> p a b (<<$>>) :: (a -> b) -> a -> b (<<**>>) :: Biapplicative p => p a c -> p (a -> b) (c -> d) -> p b d -- | Lift binary functions biliftA2 :: Biapplicative w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f -- | Lift ternary functions biliftA3 :: Biapplicative w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h instance Biapplicative Const instance Biapplicative (Tagged *) instance (Monoid x, Monoid y, Monoid z) => Biapplicative ((,,,,) x y z) instance (Monoid x, Monoid y) => Biapplicative ((,,,) x y) instance Monoid x => Biapplicative ((,,) x) instance Biapplicative (,) -- | From the Functional Pearl "Clowns to the Left of me, Jokers to the -- Right: Dissecting Data Structures" by Conor McBride. module Data.Bifunctor.Clown -- | Make a Functor over the first argument of a Bifunctor. newtype Clown f a b Clown :: f a -> Clown f a b runClown :: Clown f a b -> f a instance Eq (f a) => Eq (Clown f a b) instance Ord (f a) => Ord (Clown f a b) instance Show (f a) => Show (Clown f a b) instance Read (f a) => Read (Clown f a b) instance Traversable1 f => Bitraversable1 (Clown f) instance Foldable1 f => Bifoldable1 (Clown f) instance Traversable (Clown f a) instance Traversable f => Bitraversable (Clown f) instance Foldable (Clown f a) instance Foldable f => Bifoldable (Clown f) instance Apply f => Biapply (Clown f) instance Applicative f => Biapplicative (Clown f) instance Functor (Clown f a) instance Functor f => Bifunctor (Clown f) module Data.Bifunctor.Flip -- | Make a Functor over the first argument of a Bifunctor. newtype Flip p a b Flip :: p b a -> Flip p a b runFlip :: Flip p a b -> p b a instance Eq (p b a) => Eq (Flip p a b) instance Ord (p b a) => Ord (Flip p a b) instance Show (p b a) => Show (Flip p a b) instance Read (p b a) => Read (Flip p a b) instance Bitraversable1 p => Bitraversable1 (Flip p) instance Bifoldable1 p => Bifoldable1 (Flip p) instance Bitraversable p => Traversable (Flip p a) instance Bitraversable p => Bitraversable (Flip p) instance Bifoldable p => Foldable (Flip p a) instance Bifoldable p => Bifoldable (Flip p) instance Biapply p => Biapply (Flip p) instance Biapplicative p => Biapplicative (Flip p) instance Bifunctor p => Functor (Flip p a) instance Bifunctor p => Bifunctor (Flip p) -- | From the Functional Pearl "Clowns to the Left of me, Jokers to the -- Right: Dissecting Data Structures" by Conor McBride. module Data.Bifunctor.Joker -- | Make a Functor over the second argument of a Bifunctor. newtype Joker g a b Joker :: g b -> Joker g a b runJoker :: Joker g a b -> g b instance Eq (g b) => Eq (Joker g a b) instance Ord (g b) => Ord (Joker g a b) instance Show (g b) => Show (Joker g a b) instance Read (g b) => Read (Joker g a b) instance Traversable1 g => Traversable1 (Joker g a) instance Traversable1 g => Bitraversable1 (Joker g) instance Foldable1 g => Foldable1 (Joker g a) instance Foldable1 g => Bifoldable1 (Joker g) instance Traversable g => Traversable (Joker g a) instance Traversable g => Bitraversable (Joker g) instance Foldable g => Foldable (Joker g a) instance Foldable g => Bifoldable (Joker g) instance Apply g => Biapply (Joker g) instance Applicative g => Biapplicative (Joker g) instance Functor g => Functor (Joker g a) instance Functor g => Bifunctor (Joker g) module Data.Bifunctor.Wrapped -- | Make a Functor over the second argument of a Bifunctor. newtype WrappedBifunctor p a b WrapBifunctor :: p a b -> WrappedBifunctor p a b unwrapBifunctor :: WrappedBifunctor p a b -> p a b instance Eq (p a b) => Eq (WrappedBifunctor p a b) instance Ord (p a b) => Ord (WrappedBifunctor p a b) instance Show (p a b) => Show (WrappedBifunctor p a b) instance Read (p a b) => Read (WrappedBifunctor p a b) instance Bitraversable1 p => Bitraversable1 (WrappedBifunctor p) instance Bifoldable1 p => Bifoldable1 (WrappedBifunctor p) instance Bitraversable p => Bitraversable (WrappedBifunctor p) instance Bitraversable p => Traversable (WrappedBifunctor p a) instance Bifoldable p => Bifoldable (WrappedBifunctor p) instance Bifoldable p => Foldable (WrappedBifunctor p a) instance Biapplicative p => Biapplicative (WrappedBifunctor p) instance Biapply p => Biapply (WrappedBifunctor p) instance Bifunctor p => Functor (WrappedBifunctor p a) instance Bifunctor p => Bifunctor (WrappedBifunctor p)