{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
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.Contravariant.Divisible
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
#ifdef MIN_VERSION_StateVar
import Data.StateVar
#endif
class Contravariant f => Decide f where
decide :: (a -> Either b c) -> f b -> f c -> f a
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 = forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 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 (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
fb) (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f c
fc)
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
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 = forall (f :: * -> *) a b c.
(Generic1 f, Decide (Rep1 f)) =>
(a -> Either b c) -> f b -> f c -> f a
gdecide forall a. a -> a
id f b
fb f c
fc
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 (f :: * -> *) a. 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
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
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
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
_ V1 b
x = case V1 b
x of {}
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
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)
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)
#if !(MIN_VERSION_transformers(0,6,0))
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
#endif
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
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)
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
#ifdef MIN_VERSION_StateVar
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