content: {-# LANGUAGE Trustworthy #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Bitraversable
  -- Copyright   :  (C) 2011-2016 Edward Kmett
  -- License     :  BSD-style (see the file LICENSE)
  --
  -- Maintainer  :  libraries@haskell.org
  -- Stability   :  provisional
  -- Portability :  portable
  --
  -- @since 4.10.0.0
  ----------------------------------------------------------------------------
  module Data.Bitraversable
    ( Bitraversable(..)
    , bisequenceA
    , bisequence
    , bimapM
    , firstA
    , secondA
    , bifor
    , biforM
    , bimapAccumL
    , bimapAccumR
    , bimapDefault
    , bifoldMapDefault
    ) where
  
  import Control.Applicative
  import Data.Bifunctor
  import Data.Bifoldable
  import GHC.Internal.Data.Coerce
  import GHC.Internal.Data.Functor.Identity (Identity(..))
  import GHC.Internal.Data.Functor.Utils (StateL(..), StateR(..))
  import GHC.Generics (K1(..))
  import Prelude
  
  -- $setup
  -- >>> import Prelude
  -- >>> import GHC.Internal.Data.Maybe
  -- >>> import GHC.Internal.Data.List (find)
  
  -- | 'Bitraversable' identifies bifunctorial data structures whose elements can
  -- be traversed in order, performing 'Applicative' or 'Monad' actions at each
  -- element, and collecting a result structure with the same shape.
  --
  -- As opposed to 'Traversable' data structures, which have one variety of
  -- element on which an action can be performed, 'Bitraversable' data structures
  -- have two such varieties of elements.
  --
  -- A definition of 'bitraverse' must satisfy the following laws:
  --
  -- [Naturality]
  --   @'bitraverse' (t . f) (t . g) ≡ t . 'bitraverse' f g@
  --   for every applicative transformation @t@
  --
  -- [Identity]
  --   @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@
  --
  -- [Composition]
  --   @'Data.Functor.Compose.Compose' .
  --    'fmap' ('bitraverse' g1 g2) .
  --    'bitraverse' f1 f2
  --     ≡ 'bitraverse' ('Data.Functor.Compose.Compose' . 'fmap' g1 . f1)
  --                  ('Data.Functor.Compose.Compose' . 'fmap' g2 . f2)@
  --
  -- where an /applicative transformation/ is a function
  --
  -- @t :: ('Applicative' f, 'Applicative' g) => f a -> g a@
  --
  -- preserving the 'Applicative' operations:
  --
  -- @
  -- t ('pure' x) ≡ 'pure' x
  -- t (f '<*>' x) ≡ t f '<*>' t x
  -- @
  --
  -- and the identity functor 'Identity' and composition functors
  -- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and
  -- "Data.Functor.Compose".
  --
  -- Some simple examples are 'Either' and @(,)@:
  --
  -- > instance Bitraversable Either where
  -- >   bitraverse f _ (Left x) = Left <$> f x
  -- >   bitraverse _ g (Right y) = Right <$> g y
  -- >
  -- > instance Bitraversable (,) where
  -- >   bitraverse f g (x, y) = (,) <$> f x <*> g y
  --
  -- 'Bitraversable' relates to its superclasses in the following ways:
  --
  -- @
  -- 'bimap' f g ≡ 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)
  -- 'bifoldMap' f g ≡ 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)
  -- @
  --
  -- These are available as 'bimapDefault' and 'bifoldMapDefault' respectively.
  --
  -- If the type is also an instance of 'Traversable', then
  -- it must satisfy (up to laziness):
  --
  -- @
  -- 'traverse' ≡ 'bitraverse' 'pure'
  -- @
  --
  -- @since 4.10.0.0
  class (Bifunctor t, Bifoldable t) => Bitraversable t where
    -- | Evaluates the relevant functions at each element in the structure,
    -- running the action, and builds a new structure with the same shape, using
    -- the results produced from sequencing the actions.
    --
    -- @'bitraverse' f g ≡ 'bisequenceA' . 'bimap' f g@
    --
    -- For a version that ignores the results, see 'bitraverse_'.
    --
    -- ==== __Examples__
    --
    -- Basic usage:
    --
    -- >>> bitraverse listToMaybe (find odd) (Left [])
    -- Nothing
    --
    -- >>> bitraverse listToMaybe (find odd) (Left [1, 2, 3])
    -- Just (Left 1)
    --
    -- >>> bitraverse listToMaybe (find odd) (Right [4, 5])
    -- Just (Right 5)
    --
    -- >>> bitraverse listToMaybe (find odd) ([1, 2, 3], [4, 5])
    -- Just (1,5)
    --
    -- >>> bitraverse listToMaybe (find odd) ([], [4, 5])
    -- Nothing
    --
    -- @since 4.10.0.0
    bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
  
  -- | Alias for 'bisequence'.
  --
  -- @since 4.10.0.0
  bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
  bisequenceA = bisequence
  
  -- | Alias for 'bitraverse'.
  --
  -- @since 4.10.0.0
  bimapM :: (Bitraversable t, Applicative f)
         => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
  bimapM = bitraverse
  
  -- | Sequences all the actions in a structure, building a new structure with
  -- the same shape using the results of the actions. For a version that ignores
  -- the results, see 'bisequence_'.
  --
  -- @'bisequence' ≡ 'bitraverse' 'id' 'id'@
  --
  -- ==== __Examples__
  --
  -- Basic usage:
  --
  -- >>> bisequence (Just 4, Nothing)
  -- Nothing
  --
  -- >>> bisequence (Just 4, Just 5)
  -- Just (4,5)
  --
  -- >>> bisequence ([1, 2, 3], [4, 5])
  -- [(1,4),(1,5),(2,4),(2,5),(3,4),(3,5)]
  --
  -- @since 4.10.0.0
  bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
  bisequence = bitraverse id id
  
  -- | Traverses only over the first argument.
  --
  -- @'firstA' f ≡ 'bitraverse' f 'pure'@
  
  -- ==== __Examples__
  --
  -- Basic usage:
  --
  -- >>> firstA listToMaybe (Left [])
  -- Nothing
  --
  -- >>> firstA listToMaybe (Left [1, 2, 3])
  -- Just (Left 1)
  --
  -- >>> firstA listToMaybe (Right [4, 5])
  -- Just (Right [4, 5])
  --
  -- >>> firstA listToMaybe ([1, 2, 3], [4, 5])
  -- Just (1,[4, 5])
  --
  -- >>> firstA listToMaybe ([], [4, 5])
  -- Nothing
  
  -- @since 4.21.0.0
  firstA :: Bitraversable t => Applicative f => (a -> f c) -> t a b -> f (t c b)
  firstA f = bitraverse f pure
  
  -- | Traverses only over the second argument.
  --
  -- @'secondA' f ≡ 'bitraverse' 'pure' f@
  --
  -- ==== __Examples__
  --
  -- Basic usage:
  --
  -- >>> secondA (find odd) (Left [])
  -- Just (Left [])
  --
  -- >>> secondA (find odd) (Left [1, 2, 3])
  -- Just (Left [1,2,3])
  --
  -- >>> secondA (find odd) (Right [4, 5])
  -- Just (Right 5)
  --
  -- >>> secondA (find odd) ([1, 2, 3], [4, 5])
  -- Just ([1,2,3],5)
  --
  -- >>> secondA (find odd) ([1,2,3], [4])
  -- Nothing
  --
  -- @since 4.21.0.0
  secondA :: Bitraversable t => Applicative f => (b -> f c) -> t a b -> f (t a c)
  secondA f = bitraverse pure f
  
  -- | Class laws for tuples hold only up to laziness. The
  -- Bitraversable methods are lazier than their Traversable counterparts.
  -- For example the law @'bitraverse' 'pure' ≡ 'traverse'@ does
  -- not hold for tuples if laziness is exploited:
  --
  -- >>> (bitraverse pure pure undefined :: IO (Int, Word)) `seq` ()
  -- ()
  -- >>> (traverse pure (errorWithoutStackTrace "error!") :: IO (Int, Word)) `seq` ()
  -- *** Exception: error!
  --
  -- @since 4.10.0.0
  instance Bitraversable (,) where
    bitraverse f g ~(a, b) = liftA2 (,) (f a) (g b)
  
  -- | @since 4.10.0.0
  instance Bitraversable ((,,) x) where
    bitraverse f g ~(x, a, b) = liftA2 ((,,) x) (f a) (g b)
  
  -- | @since 4.10.0.0
  instance Bitraversable ((,,,) x y) where
    bitraverse f g ~(x, y, a, b) = liftA2 ((,,,) x y) (f a) (g b)
  
  -- | @since 4.10.0.0
  instance Bitraversable ((,,,,) x y z) where
    bitraverse f g ~(x, y, z, a, b) = liftA2 ((,,,,) x y z) (f a) (g b)
  
  -- | @since 4.10.0.0
  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)
  
  -- | @since 4.10.0.0
  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)
  
  -- | @since 4.10.0.0
  instance Bitraversable Either where
    bitraverse f _ (Left a) = Left <$> f a
    bitraverse _ g (Right b) = Right <$> g b
  
  -- | @since 4.10.0.0
  instance Bitraversable Const where
    bitraverse f _ (Const a) = Const <$> f a
  
  -- | @since 4.10.0.0
  instance Bitraversable (K1 i) where
    bitraverse f _ (K1 c) = K1 <$> f c
  
  -- | 'bifor' is 'bitraverse' with the structure as the first argument. For a
  -- version that ignores the results, see 'bifor_'.
  --
  -- ==== __Examples__
  --
  -- Basic usage:
  --
  -- >>> bifor (Left []) listToMaybe (find even)
  -- Nothing
  --
  -- >>> bifor (Left [1, 2, 3]) listToMaybe (find even)
  -- Just (Left 1)
  --
  -- >>> bifor (Right [4, 5]) listToMaybe (find even)
  -- Just (Right 4)
  --
  -- >>> bifor ([1, 2, 3], [4, 5]) listToMaybe (find even)
  -- Just (1,4)
  --
  -- >>> bifor ([], [4, 5]) listToMaybe (find even)
  -- Nothing
  --
  -- @since 4.10.0.0
  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
  
  -- | Alias for 'bifor'.
  --
  -- @since 4.10.0.0
  biforM :: (Bitraversable t, Applicative f)
         => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)
  biforM = bifor
  
  -- | The 'bimapAccumL' function behaves like a combination of 'bimap' and
  -- 'bifoldl'; it traverses a structure from left to right, threading a state
  -- of type @a@ and using the given actions to compute new elements for the
  -- structure.
  --
  -- ==== __Examples__
  --
  -- Basic usage:
  --
  -- >>> bimapAccumL (\acc bool -> (acc + 1, show bool)) (\acc string -> (acc * 2, reverse string)) 3 (True, "foo")
  -- (8,("True","oof"))
  --
  -- @since 4.10.0.0
  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
  
  -- | The 'bimapAccumR' function behaves like a combination of 'bimap' and
  -- 'bifoldr'; it traverses a structure from right to left, threading a state
  -- of type @a@ and using the given actions to compute new elements for the
  -- structure.
  --
  -- ==== __Examples__
  --
  -- Basic usage:
  --
  -- >>> bimapAccumR (\acc bool -> (acc + 1, show bool)) (\acc string -> (acc * 2, reverse string)) 3 (True, "foo")
  -- (7,("True","oof"))
  --
  -- @since 4.10.0.0
  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
  
  -- | A default definition of 'bimap' in terms of the 'Bitraversable'
  -- operations.
  --
  -- @'bimapDefault' f g ≡
  --     'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)@
  --
  -- @since 4.10.0.0
  bimapDefault :: forall t a b c d . Bitraversable t
               => (a -> b) -> (c -> d) -> t a c -> t b d
  -- See Note [Function coercion] in Data.Functor.Utils.
  bimapDefault = coerce
    (bitraverse :: (a -> Identity b)
                -> (c -> Identity d) -> t a c -> Identity (t b d))
  {-# INLINE bimapDefault #-}
  
  -- | A default definition of 'bifoldMap' in terms of the 'Bitraversable'
  -- operations.
  --
  -- @'bifoldMapDefault' f g ≡
  --    'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)@
  --
  -- @since 4.10.0.0
  bifoldMapDefault :: forall t m a b . (Bitraversable t, Monoid m)
                   => (a -> m) -> (b -> m) -> t a b -> m
  -- See Note [Function coercion] in Data.Functor.Utils.
  bifoldMapDefault = coerce
    (bitraverse :: (a -> Const m ())
                -> (b -> Const m ()) -> t a b -> Const m (t () ()))
  {-# INLINE bifoldMapDefault #-}
  