Add Bialternative

[aaditmshah]

Bialternative is for bifunctors like Either.

{-# LANGUAGE QuantifiedConstraints #-}

class (Bifunctor p, forall a. Applicative (p a)) => Bialternative p where
  {-# MINIMAL left, ((<<|>>) | liftL2) #-}
  left :: a -> p a b

  (<<|>>) :: p (a -> b) c -> p a c -> p b c
  (<<|>>) = liftL2 id

  liftL2 :: (a -> b -> c) -> p a d -> p b d -> p c d
  liftL2 f a b = f `first` a <<|>> b

  (|>>) :: p a c -> p b c -> p b c
  a |>> b = liftL2 (const id) a b

  (<<|) :: p a c -> p b c -> p a c
  a <<| b = liftL2 const a b

For example, here's the Bialternative instance of Either.

instance Bialternative Either where
  left :: a -> Either a b
  left = Left

  (<<|>>) :: Either (a -> b) c -> Either a c -> Either b c
  Left f <<|>> Left a = Left (f a)
  Right c <<|>> _ = Right c
  _ <<|>> Right c = Right c

Instances of Bialternative should satisfy the following laws.

Identity

left id <<|>> v = v

Composition

left (.) <<|>> u <<|>> v <<|>> w = u <<|>> (v <<|>> w)

Homomorphism

left f <<|>> left x = left (f x)

Interchange

u <<|>> left y = left ($ y) <<|>> u

Left Catch

pure x <<|>> v = pure x

Right Catch

left x <*> v = left x

[aaditmshah]

Just like Biapplicative, we can define a generic function to traverse a Traversable container in a Bialternative.

traverseLeft :: (Traversable t, Bialternative p) => (a -> p b c) -> t a -> p (t b) c
traverseLeft f = go . traverse (One . f)
  where
    go :: Bialternative p => Mag (p a b) a x -> p x b
    go (Pure t) = left t
    go (Map f xs) = first f (go xs)
    go (Ap fs xs) = go fs <<|>> go xs
#if MIN_VERSION_base(4,10,0)
    go (LiftA2 f xs ys) = liftL2 f (go xs) (go ys)
#endif
    go (One p) = p

This uses the same data type Mag that's defined in Data.Biapplicative.