(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-}

module Data.Bitraversable ( Bitraversable(..) , bisequenceA , bisequence , bimapM , bifor , biforM , bimapAccumL , bimapAccumR , bimapDefault , bifoldMapDefault ) where

import Control.Applicative import Data.Bifunctor import Data.Bifoldable import Data.Coerce import Data.Functor.Identity (Identity(..)) import Data.Functor.Utils (StateL(..), StateR(..)) import GHC.Generics (K1(..))

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 :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bisequenceA = bisequence

bimapM :: (Bitraversable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bimapM = bitraverse

bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bisequence = bitraverse id id

instance Bitraversable (,) where bitraverse f g ~(a, b) = liftA2 (,) (f a) (g b)

instance Bitraversable ((,,) x) where bitraverse f g ~(x, a, b) = liftA2 ((,,) x) (f a) (g b)

instance Bitraversable ((,,,) x y) where bitraverse f g ~(x, y, a, b) = liftA2 ((,,,) x y) (f a) (g b)

instance Bitraversable ((,,,,) x y z) where bitraverse f g ~(x, y, z, a, b) = liftA2 ((,,,,) x y z) (f a) (g b)

instance Bitraversable ((,,,,,) x y z w) where bitraverse f g ~(x, y, z, w, a, b) = liftA2 ((,,,,,) x y z w) (f a) (g b)

instance Bitraversable ((,,,,,,) x y z w v) where bitraverse f g ~(x, y, z, w, v, a, b) = liftA2 ((,,,,,,) x y z w v) (f a) (g b)

instance Bitraversable Either where bitraverse f _ (Left a) = Left <$> f a bitraverse _ g (Right b) = Right <$> g b

instance Bitraversable Const where bitraverse f _ (Const a) = Const <$> f a

instance Bitraversable (K1 i) where bitraverse f _ (K1 c) = K1 <$> f c

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

biforM :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d) biforM = bifor

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

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

bimapDefault :: forall t a b c d . Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d

bimapDefault = coerce (bitraverse :: (a -> Identity b) -> (c -> Identity d) -> t a c -> Identity (t b d)) {-# INLINE bimapDefault #-}

bifoldMapDefault :: forall t m a b . (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m

bifoldMapDefault = coerce (bitraverse :: (a -> Const m ()) -> (b -> Const m ()) -> t a b -> Const m (t () ())) {-# INLINE bifoldMapDefault #-}