{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE CPP              #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators    #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2021 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- This module is only available if building with GHC 8.6 or later, or if the
-- @+contravariant@ @cabal@ build flag is available.
----------------------------------------------------------------------------
module Data.Functor.Contravariant.Decide (
    Decide(..)
  , gdecide
  , decided
  , gdecided
  ) 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.Product
import Data.Functor.Reverse
import Data.Monoid (Alt(..))
import Data.Proxy
import GHC.Generics

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

#if defined(MIN_VERSION_contravariant)
import Data.Functor.Contravariant.Divisible
#endif

#ifdef MIN_VERSION_StateVar
import Data.StateVar
#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

-- | Generic 'decide'. Caveats:
--
--   1. Will not compile if @f@ is a sum type.
--   2. Will not compile if @f@ contains fields that do not mention its type variable.
--   3. @-XDeriveGeneric@ is not smart enough to make instances where the type variable appears in negative position.
--
-- @since 5.3.8
gdecide :: (Generic1 f, Decide (Rep1 f)) => (a -> Either b c) -> f b -> f c -> f a
gdecide :: forall (f :: * -> *) a b c.
(Generic1 f, Decide (Rep1 f)) =>
(a -> Either b c) -> f b -> f c -> f a
gdecide a -> Either b c
f f b
fb f c
fc = 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
$ (a -> Either b c) -> Rep1 f b -> Rep1 f c -> Rep1 f a
forall a b c. (a -> Either b c) -> Rep1 f b -> Rep1 f c -> Rep1 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 -> Rep1 f b
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
fb) (f c -> Rep1 f c
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f c
fc)

-- | 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

-- | Generic 'decided'. Caveats are the same as for 'gdecide'.
--
-- @since 5.3.8
gdecided :: (Generic1 f, Decide (Rep1 f)) => f b -> f c -> f (Either b c)
gdecided :: forall (f :: * -> *) b c.
(Generic1 f, Decide (Rep1 f)) =>
f b -> f c -> f (Either b c)
gdecided f b
fb f c
fc = (Either b c -> Either b c) -> f b -> f c -> f (Either b c)
forall (f :: * -> *) a b c.
(Generic1 f, Decide (Rep1 f)) =>
(a -> Either b c) -> f b -> f c -> f a
gdecide Either b c -> Either b c
forall a. a -> a
id f b
fb f c
fc

#if defined(MIN_VERSION_contravariant)
-- | This instance is only available if the @+contravariant@ @cabal@ flag is
-- enabled.
--
-- @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)
#endif

-- | @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
f (Comparison b -> b -> Ordering
g) (Comparison c -> c -> Ordering
h) = (a -> a -> Ordering) -> Comparison a
forall a. (a -> a -> Ordering) -> Comparison a
Comparison ((a -> a -> Ordering) -> Comparison a)
-> (a -> a -> Ordering) -> Comparison a
forall a b. (a -> b) -> a -> b
$ \a
a a
b -> case a -> Either b c
f a
a of
    Left b
c -> case a -> Either b c
f a
b of
      Left b
d -> b -> b -> Ordering
g b
c b
d
      Right{} -> Ordering
LT
    Right c
c -> case a -> Either b c
f a
b of
      Left{} -> Ordering
GT
      Right c
d -> c -> c -> Ordering
h c
c c
d

-- | @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
f (Equivalence b -> b -> Bool
g) (Equivalence c -> c -> Bool
h) = (a -> a -> Bool) -> Equivalence a
forall a. (a -> a -> Bool) -> Equivalence a
Equivalence ((a -> a -> Bool) -> Equivalence a)
-> (a -> a -> Bool) -> Equivalence a
forall a b. (a -> b) -> a -> b
$ \a
a a
b -> case a -> Either b c
f a
a of
    Left b
c -> case a -> Either b c
f a
b of
      Left b
d -> b -> b -> Bool
g b
c b
d
      Right{} -> Bool
False
    Right c
c -> case a -> Either b c
f a
b of
      Left{} -> Bool
False
      Right c
d -> c -> c -> Bool
h c
c c
d

-- | @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
f (Predicate b -> Bool
g) (Predicate c -> Bool
h) = (a -> Bool) -> Predicate a
forall a. (a -> Bool) -> Predicate a
Predicate ((a -> Bool) -> Predicate a) -> (a -> Bool) -> Predicate a
forall a b. (a -> b) -> a -> b
$ (b -> Bool) -> (c -> Bool) -> Either b c -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Bool
g c -> Bool
h (Either b c -> Bool) -> (a -> Either b c) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f

-- | 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

-- | @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

-- | @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 U1 c
U1 = U1 a
forall k (p :: k). U1 p
U1

-- | Has no 'Decidable' or 'Conclude' instance.
--
-- @since 5.3.6
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 {}

-- | @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)

-- | @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 f (ListT l) (ListT r) = ListT $ divise ((lefts &&& rights) . map f) l 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)

-- | @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

#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