{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE CPP           #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if MIN_VERSION_base(4,7,0)
{-# LANGUAGE EmptyCase     #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2021 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Functor.Contravariant.Decide (
    Decide(..)
  , decided
  ) where

import Control.Applicative.Backwards
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict

import Data.Functor.Apply
import Data.Functor.Compose
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divise
import Data.Functor.Contravariant.Divisible
import Data.Functor.Product
import Data.Functor.Reverse

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

#if MIN_VERSION_base(4,8,0)
import Data.Monoid (Alt(..))
#endif

#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
import Data.Proxy
#endif

#ifdef MIN_VERSION_StateVar
import Data.StateVar
#endif

#if __GLASGOW_HASKELL__ >= 702
#define GHC_GENERICS
import GHC.Generics
#endif

-- | The contravariant analogue of 'Alt'.
--
-- If one thinks of @f a@ as a consumer of @a@s, then 'decide' allows one
-- to handle the consumption of a value by choosing to handle it via
-- exactly one of two independent consumers.  It redirects the input
-- completely into one of two consumers.
--
-- 'decide' takes the \"decision\" method and the two potential consumers,
-- and returns the wrapped/combined consumer.
--
-- Mathematically, a functor being an instance of 'Decide' means that it is
-- \"semigroupoidal\" with respect to the contravariant \"either-based\" Day
-- convolution (@data EitherDay f g a = forall b c. EitherDay (f b) (g c) (a -> Either b c)@).
-- That is, it is possible to define a function @(f `EitherDay` f) a ->
-- f a@ in a way that is associative.
--
-- @since 5.3.6
class Contravariant f => Decide f where
    -- | Takes the \"decision\" method and the two potential consumers, and
    -- returns the wrapped/combined consumer.
    decide :: (a -> Either b c) -> f b -> f c -> f a

-- | For @'decided' x y@, the resulting @f ('Either' b c)@ will direct
-- 'Left's to be consumed by @x@, and 'Right's to be consumed by y.
--
-- @since 5.3.6
decided :: Decide f => f b -> f c -> f (Either b c)
decided :: forall (f :: * -> *) b c. Decide f => f b -> f c -> f (Either b c)
decided = (Either b c -> Either b c) -> f b -> f c -> f (Either b c)
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide Either b c -> Either b c
forall a. a -> a
id

-- | @since 5.3.6
instance Decidable f => Decide (WrappedDivisible f) where
    decide :: forall a b c.
(a -> Either b c)
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
decide a -> Either b c
f (WrapDivisible f b
x) (WrapDivisible f c
y) = f a -> WrappedDivisible f a
forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible ((a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f f b
x f c
y)

-- | @since 5.3.6
instance Decide Comparison where decide :: forall a b c.
(a -> Either b c) -> Comparison b -> Comparison c -> Comparison a
decide = (a -> Either b c) -> Comparison b -> Comparison c -> Comparison a
forall a b c.
(a -> Either b c) -> Comparison b -> Comparison c -> Comparison a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose

-- | @since 5.3.6
instance Decide Equivalence where decide :: forall a b c.
(a -> Either b c)
-> Equivalence b -> Equivalence c -> Equivalence a
decide = (a -> Either b c)
-> Equivalence b -> Equivalence c -> Equivalence a
forall a b c.
(a -> Either b c)
-> Equivalence b -> Equivalence c -> Equivalence a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose

-- | @since 5.3.6
instance Decide Predicate where decide :: forall a b c.
(a -> Either b c) -> Predicate b -> Predicate c -> Predicate a
decide = (a -> Either b c) -> Predicate b -> Predicate c -> Predicate a
forall a b c.
(a -> Either b c) -> Predicate b -> Predicate c -> Predicate a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose

-- | Unlike 'Decidable', requires no constraint on @r@.
--
-- @since 5.3.6
instance Decide (Op r) where
  decide :: forall a b c. (a -> Either b c) -> Op r b -> Op r c -> Op r a
decide a -> Either b c
f (Op b -> r
g) (Op c -> r
h) = (a -> r) -> Op r a
forall a b. (b -> a) -> Op a b
Op ((a -> r) -> Op r a) -> (a -> r) -> Op r a
forall a b. (a -> b) -> a -> b
$ (b -> r) -> (c -> r) -> Either b c -> r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> r
g c -> r
h (Either b c -> r) -> (a -> Either b c) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f

#if MIN_VERSION_base(4,8,0)
-- | @since 5.3.6
instance Decide f => Decide (Alt f) where
  decide :: forall a b c. (a -> Either b c) -> Alt f b -> Alt f c -> Alt f a
decide a -> Either b c
f (Alt f b
l) (Alt f c
r) = f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f a -> Alt f a) -> f a -> Alt f a
forall a b. (a -> b) -> a -> b
$ (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l f c
r
#endif

#ifdef GHC_GENERICS
-- | @since 5.3.6
instance Decide U1 where decide :: forall a b c. (a -> Either b c) -> U1 b -> U1 c -> U1 a
decide = (a -> Either b c) -> U1 b -> U1 c -> U1 a
forall a b c. (a -> Either b c) -> U1 b -> U1 c -> U1 a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose

-- | Has no 'Decidable' or 'Conclude' instance.
--
-- @since 5.3.6
#if MIN_VERSION_base(4,7,0)
instance Decide V1 where decide :: forall a b c. (a -> Either b c) -> V1 b -> V1 c -> V1 a
decide a -> Either b c
_ V1 b
x = case V1 b
x of {}
#else
instance Decide V1 where decide _ x = case x of !_ -> error "V1"
#endif

-- | @since 5.3.6
instance Decide f => Decide (Rec1 f) where
  decide :: forall a b c. (a -> Either b c) -> Rec1 f b -> Rec1 f c -> Rec1 f a
decide a -> Either b c
f (Rec1 f b
l) (Rec1 f c
r) = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f a -> Rec1 f a) -> f a -> Rec1 f a
forall a b. (a -> b) -> a -> b
$ (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l f c
r

-- | @since 5.3.6
instance Decide f => Decide (M1 i c f) where
  decide :: forall a b c.
(a -> Either b c) -> M1 i c f b -> M1 i c f c -> M1 i c f a
decide a -> Either b c
f (M1 f b
l) (M1 f c
r) = 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 -> M1 i c f a) -> f a -> M1 i c f a
forall a b. (a -> b) -> a -> b
$ (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l f c
r

-- | @since 5.3.6
instance (Decide f, Decide g) => Decide (f :*: g) where
  decide :: forall a b c.
(a -> Either b c) -> (:*:) f g b -> (:*:) f g c -> (:*:) f g a
decide a -> Either b c
f (f b
l1 :*: g b
r1) (f c
l2 :*: g c
r2) = (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l1 f c
l2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> Either b c) -> g b -> g c -> g a
forall a b c. (a -> Either b c) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f g b
r1 g c
r2

-- | Unlike 'Decidable', requires only 'Apply' on @f@.
--
-- @since 5.3.6
instance (Apply f, Decide g) => Decide (f :.: g) where
  decide :: forall a b c.
(a -> Either b c) -> (:.:) f g b -> (:.:) f g c -> (:.:) f g a
decide a -> Either b c
f (Comp1 f (g b)
l) (Comp1 f (g c)
r) = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 ((g b -> g c -> g a) -> f (g b) -> f (g c) -> f (g a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 ((a -> Either b c) -> g b -> g c -> g a
forall a b c. (a -> Either b c) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f) f (g b)
l f (g c)
r)
#endif

-- | @since 5.3.6
instance Decide f => Decide (Backwards f) where
  decide :: forall a b c.
(a -> Either b c)
-> Backwards f b -> Backwards f c -> Backwards f a
decide a -> Either b c
f (Backwards f b
l) (Backwards f c
r) = f a -> Backwards f a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f a -> Backwards f a) -> f a -> Backwards f a
forall a b. (a -> b) -> a -> b
$ (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l f c
r

-- | @since 5.3.6
instance Decide f => Decide (IdentityT f) where
  decide :: forall a b c.
(a -> Either b c)
-> IdentityT f b -> IdentityT f c -> IdentityT f a
decide a -> Either b c
f (IdentityT f b
l) (IdentityT f c
r) = f a -> IdentityT f a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (f a -> IdentityT f a) -> f a -> IdentityT f a
forall a b. (a -> b) -> a -> b
$ (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l f c
r

-- | @since 5.3.6
instance Decide m => Decide (ReaderT r m) where
  decide :: forall a b c.
(a -> Either b c)
-> ReaderT r m b -> ReaderT r m c -> ReaderT r m a
decide a -> Either b c
abc (ReaderT r -> m b
rmb) (ReaderT r -> m c
rmc) = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
r -> (a -> Either b c) -> m b -> m c -> m a
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
abc (r -> m b
rmb r
r) (r -> m c
rmc r
r)

-- | @since 5.3.6
instance Decide m => Decide (Lazy.RWST r w s m) where
  decide :: forall a b c.
(a -> Either b c)
-> RWST r w s m b -> RWST r w s m c -> RWST r w s m a
decide a -> Either b c
abc (Lazy.RWST r -> s -> m (b, s, w)
rsmb) (Lazy.RWST r -> s -> m (c, s, w)
rsmc) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    ((a, s, w) -> Either (b, s, w) (c, s, w))
-> m (b, s, w) -> m (c, s, w) -> m (a, s, w)
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\ ~(a
a, s
s', w
w) -> (b -> Either (b, s, w) (c, s, w))
-> (c -> Either (b, s, w) (c, s, w))
-> Either b c
-> Either (b, s, w) (c, s, w)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b, s, w) -> Either (b, s, w) (c, s, w)
forall a b. a -> Either a b
Left  ((b, s, w) -> Either (b, s, w) (c, s, w))
-> (b -> (b, s, w)) -> b -> Either (b, s, w) (c, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> w -> b -> (b, s, w)
forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s' w
w)
                                    ((c, s, w) -> Either (b, s, w) (c, s, w)
forall a b. b -> Either a b
Right ((c, s, w) -> Either (b, s, w) (c, s, w))
-> (c -> (c, s, w)) -> c -> Either (b, s, w) (c, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> w -> c -> (c, s, w)
forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s' w
w)
                                    (a -> Either b c
abc a
a))
           (r -> s -> m (b, s, w)
rsmb r
r s
s) (r -> s -> m (c, s, w)
rsmc r
r s
s)

-- | @since 5.3.6
instance Decide m => Decide (Strict.RWST r w s m) where
  decide :: forall a b c.
(a -> Either b c)
-> RWST r w s m b -> RWST r w s m c -> RWST r w s m a
decide a -> Either b c
abc (Strict.RWST r -> s -> m (b, s, w)
rsmb) (Strict.RWST r -> s -> m (c, s, w)
rsmc) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    ((a, s, w) -> Either (b, s, w) (c, s, w))
-> m (b, s, w) -> m (c, s, w) -> m (a, s, w)
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\(a
a, s
s', w
w) -> (b -> Either (b, s, w) (c, s, w))
-> (c -> Either (b, s, w) (c, s, w))
-> Either b c
-> Either (b, s, w) (c, s, w)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b, s, w) -> Either (b, s, w) (c, s, w)
forall a b. a -> Either a b
Left  ((b, s, w) -> Either (b, s, w) (c, s, w))
-> (b -> (b, s, w)) -> b -> Either (b, s, w) (c, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> w -> b -> (b, s, w)
forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s' w
w)
                                  ((c, s, w) -> Either (b, s, w) (c, s, w)
forall a b. b -> Either a b
Right ((c, s, w) -> Either (b, s, w) (c, s, w))
-> (c -> (c, s, w)) -> c -> Either (b, s, w) (c, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> w -> c -> (c, s, w)
forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s' w
w)
                                  (a -> Either b c
abc a
a))
           (r -> s -> m (b, s, w)
rsmb r
r s
s) (r -> s -> m (c, s, w)
rsmc r
r s
s)

#if !(MIN_VERSION_transformers(0,6,0))
-- | @since 5.3.6
instance Divise m => Decide (ListT m) where
  decide :: forall a b c.
(a -> Either b c) -> ListT m b -> ListT m c -> ListT m a
decide a -> Either b c
f (ListT m [b]
l) (ListT m [c]
r) = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a) -> m [a] -> ListT m a
forall a b. (a -> b) -> a -> b
$ ([a] -> ([b], [c])) -> m [b] -> m [c] -> m [a]
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (([Either b c] -> [b]
forall a b. [Either a b] -> [a]
lefts ([Either b c] -> [b])
-> ([Either b c] -> [c]) -> [Either b c] -> ([b], [c])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Either b c] -> [c]
forall a b. [Either a b] -> [b]
rights) ([Either b c] -> ([b], [c]))
-> ([a] -> [Either b c]) -> [a] -> ([b], [c])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either b c) -> [a] -> [Either b c]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either b c
f) m [b]
l m [c]
r
#endif

-- | @since 5.3.6
instance Divise m => Decide (MaybeT m) where
  decide :: forall a b c.
(a -> Either b c) -> MaybeT m b -> MaybeT m c -> MaybeT m a
decide a -> Either b c
f (MaybeT m (Maybe b)
l) (MaybeT m (Maybe c)
r) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$
    (Maybe a -> (Maybe b, Maybe c))
-> m (Maybe b) -> m (Maybe c) -> m (Maybe a)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ( (Maybe b, Maybe c)
-> (a -> (Maybe b, Maybe c)) -> Maybe a -> (Maybe b, Maybe c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b
forall a. Maybe a
Nothing, Maybe c
forall a. Maybe a
Nothing)
                   ((b -> (Maybe b, Maybe c))
-> (c -> (Maybe b, Maybe c)) -> Either b c -> (Maybe b, Maybe c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\b
b -> (b -> Maybe b
forall a. a -> Maybe a
Just b
b, Maybe c
forall a. Maybe a
Nothing))
                           (\c
c -> (Maybe b
forall a. Maybe a
Nothing, c -> Maybe c
forall a. a -> Maybe a
Just c
c)) (Either b c -> (Maybe b, Maybe c))
-> (a -> Either b c) -> a -> (Maybe b, Maybe c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)
           ) m (Maybe b)
l m (Maybe c)
r

-- | @since 5.3.6
instance Decide m => Decide (Lazy.StateT s m) where
  decide :: forall a b c.
(a -> Either b c) -> StateT s m b -> StateT s m c -> StateT s m a
decide a -> Either b c
f (Lazy.StateT s -> m (b, s)
l) (Lazy.StateT s -> m (c, s)
r) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s ->
    ((a, s) -> Either (b, s) (c, s))
-> m (b, s) -> m (c, s) -> m (a, s)
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\ ~(a
a, s
s') -> (b -> Either (b, s) (c, s))
-> (c -> Either (b, s) (c, s))
-> Either b c
-> Either (b, s) (c, s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b, s) -> Either (b, s) (c, s)
forall a b. a -> Either a b
Left ((b, s) -> Either (b, s) (c, s))
-> (b -> (b, s)) -> b -> Either (b, s) (c, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b -> (b, s)
forall s a. s -> a -> (a, s)
betuple s
s') ((c, s) -> Either (b, s) (c, s)
forall a b. b -> Either a b
Right ((c, s) -> Either (b, s) (c, s))
-> (c -> (c, s)) -> c -> Either (b, s) (c, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> c -> (c, s)
forall s a. s -> a -> (a, s)
betuple s
s') (a -> Either b c
f a
a))
           (s -> m (b, s)
l s
s) (s -> m (c, s)
r s
s)

-- | @since 5.3.6
instance Decide m => Decide (Strict.StateT s m) where
  decide :: forall a b c.
(a -> Either b c) -> StateT s m b -> StateT s m c -> StateT s m a
decide a -> Either b c
f (Strict.StateT s -> m (b, s)
l) (Strict.StateT s -> m (c, s)
r) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s ->
    ((a, s) -> Either (b, s) (c, s))
-> m (b, s) -> m (c, s) -> m (a, s)
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\(a
a, s
s') -> (b -> Either (b, s) (c, s))
-> (c -> Either (b, s) (c, s))
-> Either b c
-> Either (b, s) (c, s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b, s) -> Either (b, s) (c, s)
forall a b. a -> Either a b
Left ((b, s) -> Either (b, s) (c, s))
-> (b -> (b, s)) -> b -> Either (b, s) (c, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b -> (b, s)
forall s a. s -> a -> (a, s)
betuple s
s') ((c, s) -> Either (b, s) (c, s)
forall a b. b -> Either a b
Right ((c, s) -> Either (b, s) (c, s))
-> (c -> (c, s)) -> c -> Either (b, s) (c, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> c -> (c, s)
forall s a. s -> a -> (a, s)
betuple s
s') (a -> Either b c
f a
a))
           (s -> m (b, s)
l s
s) (s -> m (c, s)
r s
s)

-- | @since 5.3.6
instance Decide m => Decide (Lazy.WriterT w m) where
  decide :: forall a b c.
(a -> Either b c)
-> WriterT w m b -> WriterT w m c -> WriterT w m a
decide a -> Either b c
f (Lazy.WriterT m (b, w)
l) (Lazy.WriterT m (c, w)
r) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
    ((a, w) -> Either (b, w) (c, w))
-> m (b, w) -> m (c, w) -> m (a, w)
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\ ~(a
a, w
s') -> (b -> Either (b, w) (c, w))
-> (c -> Either (b, w) (c, w))
-> Either b c
-> Either (b, w) (c, w)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b, w) -> Either (b, w) (c, w)
forall a b. a -> Either a b
Left ((b, w) -> Either (b, w) (c, w))
-> (b -> (b, w)) -> b -> Either (b, w) (c, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> b -> (b, w)
forall s a. s -> a -> (a, s)
betuple w
s') ((c, w) -> Either (b, w) (c, w)
forall a b. b -> Either a b
Right ((c, w) -> Either (b, w) (c, w))
-> (c -> (c, w)) -> c -> Either (b, w) (c, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> c -> (c, w)
forall s a. s -> a -> (a, s)
betuple w
s') (a -> Either b c
f a
a)) m (b, w)
l m (c, w)
r

-- | @since 5.3.6
instance Decide m => Decide (Strict.WriterT w m) where
  decide :: forall a b c.
(a -> Either b c)
-> WriterT w m b -> WriterT w m c -> WriterT w m a
decide a -> Either b c
f (Strict.WriterT m (b, w)
l) (Strict.WriterT m (c, w)
r) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
    ((a, w) -> Either (b, w) (c, w))
-> m (b, w) -> m (c, w) -> m (a, w)
forall a b c. (a -> Either b c) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\(a
a, w
s') -> (b -> Either (b, w) (c, w))
-> (c -> Either (b, w) (c, w))
-> Either b c
-> Either (b, w) (c, w)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b, w) -> Either (b, w) (c, w)
forall a b. a -> Either a b
Left ((b, w) -> Either (b, w) (c, w))
-> (b -> (b, w)) -> b -> Either (b, w) (c, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> b -> (b, w)
forall s a. s -> a -> (a, s)
betuple w
s') ((c, w) -> Either (b, w) (c, w)
forall a b. b -> Either a b
Right ((c, w) -> Either (b, w) (c, w))
-> (c -> (c, w)) -> c -> Either (b, w) (c, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> c -> (c, w)
forall s a. s -> a -> (a, s)
betuple w
s') (a -> Either b c
f a
a)) m (b, w)
l m (c, w)
r

-- | Unlike 'Decidable', requires only 'Apply' on @f@.
--
-- @since 5.3.6
instance (Apply f, Decide g) => Decide (Compose f g) where
  decide :: forall a b c.
(a -> Either b c)
-> Compose f g b -> Compose f g c -> Compose f g a
decide a -> Either b c
f (Compose f (g b)
l) (Compose f (g c)
r) = 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 ((g b -> g c -> g a) -> f (g b) -> f (g c) -> f (g a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 ((a -> Either b c) -> g b -> g c -> g a
forall a b c. (a -> Either b c) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f) f (g b)
l f (g c)
r)

-- | @since 5.3.6
instance (Decide f, Decide g) => Decide (Product f g) where
  decide :: forall a b c.
(a -> Either b c)
-> Product f g b -> Product f g c -> Product f g a
decide a -> Either b c
f (Pair f b
l1 g b
r1) (Pair f c
l2 g c
r2) = 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 ((a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l1 f c
l2) ((a -> Either b c) -> g b -> g c -> g a
forall a b c. (a -> Either b c) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f g b
r1 g c
r2)

-- | @since 5.3.6
instance Decide f => Decide (Reverse f) where
  decide :: forall a b c.
(a -> Either b c) -> Reverse f b -> Reverse f c -> Reverse f a
decide a -> Either b c
f (Reverse f b
l) (Reverse f c
r) = f a -> Reverse f a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a -> Reverse f a) -> f a -> Reverse f a
forall a b. (a -> b) -> a -> b
$ (a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
f f b
l f c
r

betuple :: s -> a -> (a, s)
betuple :: forall s a. s -> a -> (a, s)
betuple s
s a
a = (a
a, s
s)

betuple3 :: s -> w -> a -> (a, s, w)
betuple3 :: forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s w
w a
a = (a
a, s
s, w
w)

#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
-- | @since 5.3.6
instance Decide Proxy where
  decide :: forall a b c. (a -> Either b c) -> Proxy b -> Proxy c -> Proxy a
decide a -> Either b c
_ Proxy b
Proxy Proxy c
Proxy = Proxy a
forall {k} (t :: k). Proxy t
Proxy
#endif

#ifdef MIN_VERSION_StateVar
-- | @since 5.3.6
instance Decide SettableStateVar where
  decide k (SettableStateVar l) (SettableStateVar r) = SettableStateVar $ \ a -> case k a of
    Left b -> l b
    Right c -> r c
#endif