{-# LANGUAGE CPP                  #-}
{-# LANGUAGE TypeOperators        #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

-- |
-- Module      : Data.Functor.Contravariant.Decide
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- The contravariant counterpart of 'Alt': like 'Decidable', but without
-- 'Data.Functor.Contravariant.Divisible.loss' or a superclass constraint
-- on 'Divisible'.  This is only a part of this library currently for
-- compatibility, until it is (hopefully) merged into /semigroupoids/.
--
-- @since 0.3.0.0
module Data.Functor.Contravariant.Decide (
    Decide(..)
  , decided
  ) where

import Control.Applicative.Backwards
import Control.Arrow
import Control.Monad.Trans.Identity
import Control.Monad.Trans.List
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Either
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
import qualified Control.Monad.Trans.RWS.Lazy      as Lazy
import qualified Control.Monad.Trans.RWS.Strict    as Strict
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

#if MIN_VERSION_base(4,8,0)
import Data.Monoid (Alt(..))
#else
import Data.Monoid (Monoid(..))
#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
-- "semgroupoidal" 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.
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.
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 = forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide forall a. a -> a
id

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) = forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisible f a
WrapDivisible (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)

instance Decide Comparison where decide :: forall a b c.
(a -> Either b c) -> Comparison b -> Comparison c -> Comparison a
decide = forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose
instance Decide Equivalence where decide :: forall a b c.
(a -> Either b c)
-> Equivalence b -> Equivalence c -> Equivalence a
decide = forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose
instance Decide Predicate where decide :: forall a b c.
(a -> Either b c) -> Predicate b -> Predicate c -> Predicate a
decide = 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@
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) = forall a b. (b -> a) -> Op a b
Op forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> r
g c -> r
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f

#if MIN_VERSION_base(4,8,0)
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) = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt forall a b. (a -> b) -> a -> b
$ 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
instance Decide U1 where decide :: forall a b c. (a -> Either b c) -> U1 b -> U1 c -> U1 a
decide = forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose
instance Decide V1 where decide :: forall a b c. (a -> Either b c) -> V1 b -> V1 c -> V1 a
decide a -> Either b c
_ = \case {}

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) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall a b. (a -> b) -> a -> b
$ 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

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) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall a b. (a -> b) -> a -> b
$ 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

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) = 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 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: 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@.
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) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (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

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) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall a b. (a -> b) -> a -> b
$ 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

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) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ 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

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) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> 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)

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) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\ ~(a
a, s
s', w
w) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s' w
w)
                                    (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)

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) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\(a
a, s
s', w
w) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s w a. s -> w -> a -> (a, s, w)
betuple3 s
s' w
w)
                                  (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)

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) = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ((forall a b. [Either a b] -> [a]
lefts forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b. [Either a b] -> [b]
rights) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> Either b c
f) m [b]
l m [c]
r

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) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
                   (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\b
b -> (forall a. a -> Maybe a
Just b
b, forall a. Maybe a
Nothing))
                           (\c
c -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just c
c)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)
           ) m (Maybe b)
l m (Maybe c)
r

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) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s ->
    forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\ ~(a
a, s
s') -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. s -> a -> (a, s)
betuple s
s') (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)

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) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s ->
    forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\(a
a, s
s') -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. s -> a -> (a, s)
betuple s
s') (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)

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) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\ ~(a
a, w
s') -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. s -> a -> (a, s)
betuple w
s') (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

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) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide (\(a
a, w
s') -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. s -> a -> (a, s)
betuple w
s') (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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@.
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) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (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)

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) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (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) (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)

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) = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall a b. (a -> b) -> a -> b
$ 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)
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 = forall {k} (t :: k). Proxy t
Proxy
#endif

#ifdef MIN_VERSION_StateVar
instance Decide SettableStateVar where
  decide :: forall a b c.
(a -> Either b c)
-> SettableStateVar b -> SettableStateVar c -> SettableStateVar a
decide a -> Either b c
k (SettableStateVar b -> IO ()
l) (SettableStateVar c -> IO ()
r) = forall a. (a -> IO ()) -> SettableStateVar a
SettableStateVar forall a b. (a -> b) -> a -> b
$ \ a
a -> case a -> Either b c
k a
a of
    Left b
b -> b -> IO ()
l b
b
    Right c
c -> c -> IO ()
r c
c
#endif