{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# options_ghc -Wno-deprecations #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Alt
-- Copyright   :  (C) 2011-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Functor.Alt
  ( Alt(..)
  , optional
  , galt
  , module Data.Functor.Apply
  ) where

import Control.Applicative hiding (some, many, optional)
import Control.Applicative.Backwards
import Control.Applicative.Lift
import Control.Arrow
import Control.Exception (catch, SomeException)
import Control.Monad
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.RWS.CPS as CPS
import qualified Control.Monad.Trans.Writer.CPS as CPS
import Semigroupoids.Internal
#endif
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import Data.Functor.Apply
import Data.Functor.Compose
import Data.Functor.Identity (Identity (Identity))
import Data.Functor.Product
import Data.Functor.Reverse
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Monoid as Monoid
import Data.Proxy
import Data.Semigroup (Semigroup(..))
import qualified Data.Semigroup as Semigroup
import GHC.Generics
import Prelude (($),Either(..),Maybe(..),const,IO,(++),(.),either,seq,undefined,repeat,mappend)
import Unsafe.Coerce

#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif

#if !(MIN_VERSION_base(4,16,0))
import Data.Semigroup (Option(..))
#endif

#ifdef MIN_VERSION_containers
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
import Data.Sequence (Seq)
import qualified Data.Map as Map
import Data.Map (Map)
import Prelude (Ord)
#endif

#ifdef MIN_VERSION_unordered_containers
import Data.Hashable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import Prelude (Eq)
#endif

infixl 3 <!>

-- | Laws:
--
-- > <!> is associative:             (a <!> b) <!> c = a <!> (b <!> c)
-- > <$> left-distributes over <!>:  f <$> (a <!> b) = (f <$> a) <!> (f <$> b)
--
-- If extended to an 'Alternative' then '<!>' should equal '<|>'.
--
-- Ideally, an instance of 'Alt' also satisfies the \"left distribution\" law of
-- MonadPlus with respect to '<.>':
--
-- > <.> right-distributes over <!>: (a <!> b) <.> c = (a <.> c) <!> (b <.> c)
--
-- 'IO', @'Either' a@, @'ExceptT' e m@ and 'GHC.Conc.STM' instead satisfy the
-- \"left catch\" law:
--
-- > pure a <!> b = pure a
--
-- 'Maybe' and 'Identity' satisfy both \"left distribution\" and \"left catch\".
--
-- These variations cannot be stated purely in terms of the dependencies of 'Alt'.
--
-- When and if MonadPlus is successfully refactored, this class should also
-- be refactored to remove these instances.
--
-- The right distributive law should extend in the cases where the a 'Bind' or 'Monad' is
-- provided to yield variations of the right distributive law:
--
-- > (m <!> n) >>- f = (m >>- f) <!> (m >>- f)
-- > (m <!> n) >>= f = (m >>= f) <!> (m >>= f)

class Functor f => Alt f where
  -- | '<|>' without a required @empty@
  (<!>) :: f a -> f a -> f a

  some :: Applicative f => f a -> f [a]
  some f a
v = f [a]
some_v
    where many_v :: f [a]
many_v = f [a]
some_v f [a] -> f [a] -> f [a]
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          some_v :: f [a]
some_v = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v f ([a] -> [a]) -> f [a] -> f [a]
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a]
many_v

  many :: Applicative f => f a -> f [a]
  many f a
v = f [a]
many_v
    where many_v :: f [a]
many_v = f [a]
some_v f [a] -> f [a] -> f [a]
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          some_v :: f [a]
some_v = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v f ([a] -> [a]) -> f [a] -> f [a]
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a]
many_v

-- | One or none.
optional :: (Alt f, Applicative f) => f a -> f (Maybe a)
optional :: forall (f :: * -> *) a.
(Alt f, Applicative f) =>
f a -> f (Maybe a)
optional f a
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v f (Maybe a) -> f (Maybe a) -> f (Maybe a)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Generic ('<!>'). Caveats:
--
--   1. Will not compile if @f@ is a sum type.
--   2. Any types where the @a@ does not appear must have a 'Semigroup' instance.
--
-- @since 5.3.8
galt :: (Generic1 f, Alt (Rep1 f)) => f a -> f a -> f a
galt :: forall (f :: * -> *) a.
(Generic1 f, Alt (Rep1 f)) =>
f a -> f a -> f a
galt f a
as f a
bs = Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f a -> f a) -> Rep1 f a -> f a
forall a b. (a -> b) -> a -> b
$ f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
as Rep1 f a -> Rep1 f a -> Rep1 f a
forall a. Rep1 f a -> Rep1 f a -> Rep1 f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
bs

instance (Alt f, Alt g) => Alt (f :*: g) where
  (f a
as :*: g a
bs) <!> :: forall a. (:*:) f g a -> (:*:) f g a -> (:*:) f g a
<!> (f a
cs :*: g a
ds) = (f a
as f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
cs) f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (g a
bs g a -> g a -> g a
forall a. g a -> g a -> g a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> g a
ds)

-- | @since 5.3.8
instance (Alt f, Functor g) => Alt (f :.: g) where
  Comp1 f (g a)
as <!> :: forall a. (:.:) f g a -> (:.:) f g a -> (:.:) f g a
<!> Comp1 f (g a)
bs = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a)
as f (g a) -> f (g a) -> f (g a)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f (g a)
bs)

newtype Magic f = Magic { forall (f :: * -> *).
Magic f -> forall a. Applicative f => f a -> f [a]
runMagic :: forall a. Applicative f => f a -> f [a] }

instance Alt f => Alt (M1 i c f) where
  M1 f a
f <!> :: forall a. M1 i c f a -> M1 i c f a -> M1 i c f a
<!> M1 f a
g = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a
f f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
g)
  some :: forall a. Applicative (M1 i c f) => M1 i c f a -> M1 i c f [a]
some = Magic (M1 i c f)
-> forall a. Applicative (M1 i c f) => M1 i c f a -> M1 i c f [a]
forall (f :: * -> *).
Magic f -> forall a. Applicative f => f a -> f [a]
runMagic (Magic f -> Magic (M1 i c f)
forall a b. a -> b
unsafeCoerce ((forall a. Applicative f => f a -> f [a]) -> Magic f
forall (f :: * -> *).
(forall a. Applicative f => f a -> f [a]) -> Magic f
Magic f a -> f [a]
forall a. Applicative f => f a -> f [a]
forall (f :: * -> *) a. (Alt f, Applicative f) => f a -> f [a]
some :: Magic f))
  many :: forall a. Applicative (M1 i c f) => M1 i c f a -> M1 i c f [a]
many = Magic (M1 i c f)
-> forall a. Applicative (M1 i c f) => M1 i c f a -> M1 i c f [a]
forall (f :: * -> *).
Magic f -> forall a. Applicative f => f a -> f [a]
runMagic (Magic f -> Magic (M1 i c f)
forall a b. a -> b
unsafeCoerce ((forall a. Applicative f => f a -> f [a]) -> Magic f
forall (f :: * -> *).
(forall a. Applicative f => f a -> f [a]) -> Magic f
Magic f a -> f [a]
forall a. Applicative f => f a -> f [a]
forall (f :: * -> *) a. (Alt f, Applicative f) => f a -> f [a]
many :: Magic f))

instance Alt f => Alt (Rec1 f) where
  Rec1 f a
f <!> :: forall a. Rec1 f a -> Rec1 f a -> Rec1 f a
<!> Rec1 f a
g = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f a
f f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
g)
  some :: forall a. Applicative (Rec1 f) => Rec1 f a -> Rec1 f [a]
some = Magic (Rec1 f)
-> forall a. Applicative (Rec1 f) => Rec1 f a -> Rec1 f [a]
forall (f :: * -> *).
Magic f -> forall a. Applicative f => f a -> f [a]
runMagic (Magic f -> Magic (Rec1 f)
forall a b. a -> b
unsafeCoerce ((forall a. Applicative f => f a -> f [a]) -> Magic f
forall (f :: * -> *).
(forall a. Applicative f => f a -> f [a]) -> Magic f
Magic f a -> f [a]
forall a. Applicative f => f a -> f [a]
forall (f :: * -> *) a. (Alt f, Applicative f) => f a -> f [a]
some :: Magic f))
  many :: forall a. Applicative (Rec1 f) => Rec1 f a -> Rec1 f [a]
many = Magic (Rec1 f)
-> forall a. Applicative (Rec1 f) => Rec1 f a -> Rec1 f [a]
forall (f :: * -> *).
Magic f -> forall a. Applicative f => f a -> f [a]
runMagic (Magic f -> Magic (Rec1 f)
forall a b. a -> b
unsafeCoerce ((forall a. Applicative f => f a -> f [a]) -> Magic f
forall (f :: * -> *).
(forall a. Applicative f => f a -> f [a]) -> Magic f
Magic f a -> f [a]
forall a. Applicative f => f a -> f [a]
forall (f :: * -> *) a. (Alt f, Applicative f) => f a -> f [a]
many :: Magic f))

-- | @since 5.3.8@
instance Semigroup c => Alt (K1 i c) where
  K1 c
c1 <!> :: forall a. K1 i c a -> K1 i c a -> K1 i c a
<!> K1 c
c2 = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c a) -> c -> K1 i c a
forall a b. (a -> b) -> a -> b
$ c
c1 c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
c2

instance Alt U1 where
  U1 a
_ <!> :: forall a. U1 a -> U1 a -> U1 a
<!> U1 a
_ = U1 a
forall k (p :: k). U1 p
U1
  some :: forall a. Applicative U1 => U1 a -> U1 [a]
some U1 a
_ = U1 [a]
forall k (p :: k). U1 p
U1
  many :: forall a. Applicative U1 => U1 a -> U1 [a]
many U1 a
_ = U1 [a]
forall k (p :: k). U1 p
U1

instance Alt V1 where
  V1 a
v <!> :: forall a. V1 a -> V1 a -> V1 a
<!> V1 a
u = V1 a
v V1 a -> V1 a -> V1 a
forall a b. a -> b -> b
`seq` V1 a
u V1 a -> V1 a -> V1 a
forall a b. a -> b -> b
`seq` V1 a
forall a. HasCallStack => a
undefined
  some :: forall a. Applicative V1 => V1 a -> V1 [a]
some V1 a
v = V1 a
v V1 a -> V1 [a] -> V1 [a]
forall a b. a -> b -> b
`seq` V1 [a]
forall a. HasCallStack => a
undefined
  many :: forall a. Applicative V1 => V1 a -> V1 [a]
many V1 a
v = V1 a
v V1 a -> V1 [a] -> V1 [a]
forall a b. a -> b -> b
`seq` V1 [a]
forall a. HasCallStack => a
undefined

instance Alt Proxy where
  Proxy a
_ <!> :: forall a. Proxy a -> Proxy a -> Proxy a
<!> Proxy a
_ = Proxy a
forall {k} (t :: k). Proxy t
Proxy
  some :: forall a. Applicative Proxy => Proxy a -> Proxy [a]
some Proxy a
_ = Proxy [a]
forall {k} (t :: k). Proxy t
Proxy
  many :: forall a. Applicative Proxy => Proxy a -> Proxy [a]
many Proxy a
_ = Proxy [a]
forall {k} (t :: k). Proxy t
Proxy

instance Alt (Either a) where
  Left a
_ <!> :: forall a. Either a a -> Either a a -> Either a a
<!> Either a a
b = Either a a
b
  Either a a
a      <!> Either a a
_ = Either a a
a

-- | This instance does not actually satisfy the ('<.>') right distributive law
-- It instead satisfies the \"left catch\" law
instance Alt IO where
  IO a
m <!> :: forall a. IO a -> IO a -> IO a
<!> IO a
n = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
m (IO a -> SomeException -> IO a
forall x. x -> SomeException -> x
go IO a
n) where
    go :: x -> SomeException -> x
    go :: forall x. x -> SomeException -> x
go = x -> SomeException -> x
forall a b. a -> b -> a
const

-- | Choose the first option every time. While \'choose the last option\' every
-- time is also valid, this instance satisfies more laws.
--
-- @since 5.3.6
instance Alt Identity where
  {-# INLINEABLE (<!>) #-}
  Identity a
m <!> :: forall a. Identity a -> Identity a -> Identity a
<!> Identity a
_ = Identity a
m
  some :: forall a. Applicative Identity => Identity a -> Identity [a]
some (Identity a
x) = [a] -> Identity [a]
forall a. a -> Identity a
Identity ([a] -> Identity [a]) -> (a -> [a]) -> a -> Identity [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a. a -> [a]
repeat (a -> Identity [a]) -> a -> Identity [a]
forall a b. (a -> b) -> a -> b
$ a
x
  many :: forall a. Applicative Identity => Identity a -> Identity [a]
many (Identity a
x) = [a] -> Identity [a]
forall a. a -> Identity a
Identity ([a] -> Identity [a]) -> (a -> [a]) -> a -> Identity [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a. a -> [a]
repeat (a -> Identity [a]) -> a -> Identity [a]
forall a b. (a -> b) -> a -> b
$ a
x

instance Alt [] where
  <!> :: forall a. [a] -> [a] -> [a]
(<!>) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

instance Alt Maybe where
  Maybe a
Nothing <!> :: forall a. Maybe a -> Maybe a -> Maybe a
<!> Maybe a
b = Maybe a
b
  Maybe a
a       <!> Maybe a
_ = Maybe a
a

#if !(MIN_VERSION_base(4,16,0))
instance Alt Option where
  (<!>) = (<|>)
#endif

instance MonadPlus m => Alt (WrappedMonad m) where
  <!> :: forall a. WrappedMonad m a -> WrappedMonad m a -> WrappedMonad m a
(<!>) = WrappedMonad m a -> WrappedMonad m a -> WrappedMonad m a
forall a. WrappedMonad m a -> WrappedMonad m a -> WrappedMonad m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance ArrowPlus a => Alt (WrappedArrow a b) where
  <!> :: forall a.
WrappedArrow a b a -> WrappedArrow a b a -> WrappedArrow a b a
(<!>) = WrappedArrow a b a -> WrappedArrow a b a -> WrappedArrow a b a
forall a.
WrappedArrow a b a -> WrappedArrow a b a -> WrappedArrow a b a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

#ifdef MIN_VERSION_containers
instance Ord k => Alt (Map k) where
  <!> :: forall a. Map k a -> Map k a -> Map k a
(<!>) = Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

instance Alt IntMap where
  <!> :: forall a. IntMap a -> IntMap a -> IntMap a
(<!>) = IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union

instance Alt Seq where
  <!> :: forall a. Seq a -> Seq a -> Seq a
(<!>) = Seq a -> Seq a -> Seq a
forall a. Monoid a => a -> a -> a
mappend
#endif

#ifdef MIN_VERSION_unordered_containers
instance (Hashable k, Eq k) => Alt (HashMap k) where
  <!> :: forall a. HashMap k a -> HashMap k a -> HashMap k a
(<!>) = HashMap k a -> HashMap k a -> HashMap k a
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
HashMap.union
#endif

instance Alt NonEmpty where
  (a
a :| [a]
as) <!> :: forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
<!> ~(a
b :| [a]
bs) = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
bs)

instance Alternative f => Alt (WrappedApplicative f) where
  WrapApplicative f a
a <!> :: forall a.
WrappedApplicative f a
-> WrappedApplicative f a -> WrappedApplicative f a
<!> WrapApplicative f a
b = f a -> WrappedApplicative f a
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f a
a f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
b)

instance Alt f => Alt (IdentityT f) where
  IdentityT f a
a <!> :: forall a. IdentityT f a -> IdentityT f a -> IdentityT f a
<!> IdentityT f a
b = f a -> IdentityT f a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (f a
a f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
b)

instance Alt f => Alt (ReaderT e f) where
  ReaderT e -> f a
a <!> :: forall a. ReaderT e f a -> ReaderT e f a -> ReaderT e f a
<!> ReaderT e -> f a
b = (e -> f a) -> ReaderT e f a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> f a) -> ReaderT e f a) -> (e -> f a) -> ReaderT e f a
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> f a
a e
e f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> e -> f a
b e
e

instance (Functor f, Monad f) => Alt (MaybeT f) where
  MaybeT f (Maybe a)
a <!> :: forall a. MaybeT f a -> MaybeT f a -> MaybeT f a
<!> MaybeT f (Maybe a)
b = f (Maybe a) -> MaybeT f a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (f (Maybe a) -> MaybeT f a) -> f (Maybe a) -> MaybeT f a
forall a b. (a -> b) -> a -> b
$ do
    Maybe a
v <- f (Maybe a)
a
    case Maybe a
v of
      Maybe a
Nothing -> f (Maybe a)
b
      Just a
_ -> Maybe a -> f (Maybe a)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v

#if !(MIN_VERSION_transformers(0,6,0))
instance (Functor f, Monad f) => Alt (ErrorT e f) where
  ErrorT m <!> ErrorT n = ErrorT $ do
    a <- m
    case a of
      Left _ -> n
      Right r -> return (Right r)

instance Apply f => Alt (ListT f) where
  ListT a <!> ListT b = ListT $ (<!>) <$> a <.> b
#endif

instance (Functor f, Monad f, Semigroup e) => Alt (ExceptT e f) where
  ExceptT f (Either e a)
m <!> :: forall a. ExceptT e f a -> ExceptT e f a -> ExceptT e f a
<!> ExceptT f (Either e a)
n = f (Either e a) -> ExceptT e f a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (f (Either e a) -> ExceptT e f a)
-> f (Either e a) -> ExceptT e f a
forall a b. (a -> b) -> a -> b
$ do
    Either e a
a <- f (Either e a)
m
    case Either e a
a of
      Left e
e -> (Either e a -> Either e a) -> f (Either e a) -> f (Either e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((e -> Either e a) -> (a -> Either e a) -> Either e a -> Either e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> (e -> e) -> e -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e -> e
forall a. Semigroup a => a -> a -> a
(<>) e
e) a -> Either e a
forall a b. b -> Either a b
Right) f (Either e a)
n
      Right a
x -> Either e a -> f (Either e a)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either e a
forall a b. b -> Either a b
Right a
x)


instance Alt f => Alt (Strict.StateT e f) where
  Strict.StateT e -> f (a, e)
m <!> :: forall a. StateT e f a -> StateT e f a -> StateT e f a
<!> Strict.StateT e -> f (a, e)
n = (e -> f (a, e)) -> StateT e f a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((e -> f (a, e)) -> StateT e f a)
-> (e -> f (a, e)) -> StateT e f a
forall a b. (a -> b) -> a -> b
$ \e
s -> e -> f (a, e)
m e
s f (a, e) -> f (a, e) -> f (a, e)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> e -> f (a, e)
n e
s

instance Alt f => Alt (Lazy.StateT e f) where
  Lazy.StateT e -> f (a, e)
m <!> :: forall a. StateT e f a -> StateT e f a -> StateT e f a
<!> Lazy.StateT e -> f (a, e)
n = (e -> f (a, e)) -> StateT e f a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((e -> f (a, e)) -> StateT e f a)
-> (e -> f (a, e)) -> StateT e f a
forall a b. (a -> b) -> a -> b
$ \e
s -> e -> f (a, e)
m e
s f (a, e) -> f (a, e) -> f (a, e)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> e -> f (a, e)
n e
s

instance Alt f => Alt (Strict.WriterT w f) where
  Strict.WriterT f (a, w)
m <!> :: forall a. WriterT w f a -> WriterT w f a -> WriterT w f a
<!> Strict.WriterT f (a, w)
n = f (a, w) -> WriterT w f a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (f (a, w) -> WriterT w f a) -> f (a, w) -> WriterT w f a
forall a b. (a -> b) -> a -> b
$ f (a, w)
m f (a, w) -> f (a, w) -> f (a, w)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f (a, w)
n

instance Alt f => Alt (Lazy.WriterT w f) where
  Lazy.WriterT f (a, w)
m <!> :: forall a. WriterT w f a -> WriterT w f a -> WriterT w f a
<!> Lazy.WriterT f (a, w)
n = f (a, w) -> WriterT w f a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (f (a, w) -> WriterT w f a) -> f (a, w) -> WriterT w f a
forall a b. (a -> b) -> a -> b
$ f (a, w)
m f (a, w) -> f (a, w) -> f (a, w)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f (a, w)
n

#if MIN_VERSION_transformers(0,5,6)
-- | @since 5.3.6
instance (Alt f) => Alt (CPS.WriterT w f) where
  WriterT w f a
m <!> :: forall a. WriterT w f a -> WriterT w f a -> WriterT w f a
<!> WriterT w f a
n = (w -> f (a, w)) -> WriterT w f a
forall w (m :: * -> *) a. (w -> m (a, w)) -> WriterT w m a
mkWriterT ((w -> f (a, w)) -> WriterT w f a)
-> (w -> f (a, w)) -> WriterT w f a
forall a b. (a -> b) -> a -> b
$ \w
w -> WriterT w f a -> w -> f (a, w)
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT WriterT w f a
m w
w f (a, w) -> f (a, w) -> f (a, w)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> WriterT w f a -> w -> f (a, w)
forall w (m :: * -> *) a. WriterT w m a -> w -> m (a, w)
unWriterT WriterT w f a
n w
w
#endif

instance Alt f => Alt (Strict.RWST r w s f) where
  Strict.RWST r -> s -> f (a, s, w)
m <!> :: forall a. RWST r w s f a -> RWST r w s f a -> RWST r w s f a
<!> Strict.RWST r -> s -> f (a, s, w)
n = (r -> s -> f (a, s, w)) -> RWST r w s f a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> f (a, s, w)) -> RWST r w s f a)
-> (r -> s -> f (a, s, w)) -> RWST r w s f a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> r -> s -> f (a, s, w)
m r
r s
s f (a, s, w) -> f (a, s, w) -> f (a, s, w)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> r -> s -> f (a, s, w)
n r
r s
s

instance Alt f => Alt (Lazy.RWST r w s f) where
  Lazy.RWST r -> s -> f (a, s, w)
m <!> :: forall a. RWST r w s f a -> RWST r w s f a -> RWST r w s f a
<!> Lazy.RWST r -> s -> f (a, s, w)
n = (r -> s -> f (a, s, w)) -> RWST r w s f a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> f (a, s, w)) -> RWST r w s f a)
-> (r -> s -> f (a, s, w)) -> RWST r w s f a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> r -> s -> f (a, s, w)
m r
r s
s f (a, s, w) -> f (a, s, w) -> f (a, s, w)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> r -> s -> f (a, s, w)
n r
r s
s

#if MIN_VERSION_transformers(0,5,6)
-- | @since 5.3.6
instance (Alt f) => Alt (CPS.RWST r w s f) where
  RWST r w s f a
m <!> :: forall a. RWST r w s f a -> RWST r w s f a -> RWST r w s f a
<!> RWST r w s f a
n = (r -> s -> w -> f (a, s, w)) -> RWST r w s f a
forall r s w (m :: * -> *) a.
(r -> s -> w -> m (a, s, w)) -> RWST r w s m a
mkRWST ((r -> s -> w -> f (a, s, w)) -> RWST r w s f a)
-> (r -> s -> w -> f (a, s, w)) -> RWST r w s f a
forall a b. (a -> b) -> a -> b
$ \r
r s
s w
w -> RWST r w s f a -> r -> s -> w -> f (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST RWST r w s f a
m r
r s
s w
w f (a, s, w) -> f (a, s, w) -> f (a, s, w)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> RWST r w s f a -> r -> s -> w -> f (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> w -> m (a, s, w)
unRWST RWST r w s f a
n r
r s
s w
w
#endif

instance Alt f => Alt (Backwards f) where
  Backwards f a
a <!> :: forall a. Backwards f a -> Backwards f a -> Backwards f a
<!> Backwards f a
b = f a -> Backwards f a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f a
a f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
b)

instance (Alt f, Functor g) => Alt (Compose f g) where
  Compose f (g a)
a <!> :: forall a. Compose f g a -> Compose f g a -> Compose f g a
<!> Compose f (g a)
b = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a)
a f (g a) -> f (g a) -> f (g a)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f (g a)
b)

instance Alt f => Alt (Lift f) where
  Pure a
a   <!> :: forall a. Lift f a -> Lift f a -> Lift f a
<!> Lift f a
_       = a -> Lift f a
forall (f :: * -> *) a. a -> Lift f a
Pure a
a
  Other f a
_  <!> Pure a
b  = a -> Lift f a
forall (f :: * -> *) a. a -> Lift f a
Pure a
b
  Other f a
a  <!> Other f a
b = f a -> Lift f a
forall (f :: * -> *) a. f a -> Lift f a
Other (f a
a f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
b)

instance (Alt f, Alt g) => Alt (Product f g) where
  Pair f a
a1 g a
b1 <!> :: forall a. Product f g a -> Product f g a -> Product f g a
<!> Pair f a
a2 g a
b2 = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f a
a1 f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
a2) (g a
b1 g a -> g a -> g a
forall a. g a -> g a -> g a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> g a
b2)

instance Alt f => Alt (Reverse f) where
  Reverse f a
a <!> :: forall a. Reverse f a -> Reverse f a -> Reverse f a
<!> Reverse f a
b = f a -> Reverse f a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a
a f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
b)

instance Alt Semigroup.First where
  <!> :: forall a. First a -> First a -> First a
(<!>) = First a -> First a -> First a
forall a. Semigroup a => a -> a -> a
(<>)

instance Alt Semigroup.Last where
  <!> :: forall a. Last a -> Last a -> Last a
(<!>) = Last a -> Last a -> Last a
forall a. Semigroup a => a -> a -> a
(<>)

instance Alt Monoid.First where
  <!> :: forall a. First a -> First a -> First a
(<!>) = First a -> First a -> First a
forall a. Monoid a => a -> a -> a
mappend

instance Alt Monoid.Last where
  <!> :: forall a. Last a -> Last a -> Last a
(<!>) = Last a -> Last a -> Last a
forall a. Monoid a => a -> a -> a
mappend