{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if !(MIN_VERSION_transformers(0,6,0))
{-# OPTIONS_GHC -fno-warn-deprecations #-}
#endif
module Data.Functor.Contravariant.Divisible
(
Divisible(..), divided, conquered, liftD
, Decidable(..), chosen, lost
) where
import Control.Applicative
import Control.Applicative.Backwards
import Control.Arrow
import Control.Monad.Trans.Except
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.Compose
import Data.Functor.Constant
import Data.Functor.Contravariant
import Data.Functor.Product
import Data.Functor.Reverse
import Data.Void
#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
import Data.Either
#endif
#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
class Contravariant f => Divisible f where
divide :: (a -> (b, c)) -> f b -> f c -> f a
conquer :: f a
divided :: Divisible f => f a -> f b -> f (a, b)
divided :: forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
divided = ((a, b) -> (a, b)) -> f a -> f b -> f (a, b)
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (a, b) -> (a, b)
forall a. a -> a
id
conquered :: Divisible f => f ()
conquered :: forall (f :: * -> *). Divisible f => f ()
conquered = f ()
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
liftD :: Divisible f => (a -> b) -> f b -> f a
liftD :: forall (f :: * -> *) a b. Divisible f => (a -> b) -> f b -> f a
liftD a -> b
f = (a -> ((), b)) -> f () -> f b -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide ((,) () (b -> ((), b)) -> (a -> b) -> a -> ((), b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) f ()
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Monoid r => Divisible (Op r) where
divide :: forall a b c. (a -> (b, c)) -> Op r b -> Op r c -> Op r a
divide a -> (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
$ \a
a -> case a -> (b, c)
f a
a of
(b
b, c
c) -> b -> r
g b
b r -> r -> r
forall a. Monoid a => a -> a -> a
`mappend` c -> r
h c
c
conquer :: forall a. Op r a
conquer = (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
$ r -> a -> r
forall a b. a -> b -> a
const r
forall a. Monoid a => a
mempty
instance Divisible Comparison where
divide :: forall a b c.
(a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
divide a -> (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 -> (b, c)
f a
a of
(b
a',c
a'') -> case a -> (b, c)
f a
b of
(b
b',c
b'') -> b -> b -> Ordering
g b
a' b
b' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` c -> c -> Ordering
h c
a'' c
b''
conquer :: forall a. Comparison a
conquer = (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
_ -> Ordering
EQ
instance Divisible Equivalence where
divide :: forall a b c.
(a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
divide a -> (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 -> (b, c)
f a
a of
(b
a',c
a'') -> case a -> (b, c)
f a
b of
(b
b',c
b'') -> b -> b -> Bool
g b
a' b
b' Bool -> Bool -> Bool
&& c -> c -> Bool
h c
a'' c
b''
conquer :: forall a. Equivalence a
conquer = (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
_ -> Bool
True
instance Divisible Predicate where
divide :: forall a b c.
(a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
divide a -> (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
$ \a
a -> case a -> (b, c)
f a
a of
(b
b, c
c) -> b -> Bool
g b
b Bool -> Bool -> Bool
&& c -> Bool
h c
c
conquer :: forall a. Predicate a
conquer = (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
$ Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True
instance Monoid m => Divisible (Const m) where
divide :: forall a b c. (a -> (b, c)) -> Const m b -> Const m c -> Const m a
divide a -> (b, c)
_ (Const m
a) (Const m
b) = m -> Const m a
forall {k} a (b :: k). a -> Const a b
Const (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
a m
b)
conquer :: forall a. Const m a
conquer = m -> Const m a
forall {k} a (b :: k). a -> Const a b
Const m
forall a. Monoid a => a
mempty
#if MIN_VERSION_base(4,8,0)
instance Divisible f => Divisible (Alt f) where
divide :: forall a b c. (a -> (b, c)) -> Alt f b -> Alt f c -> Alt f a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l f c
r
conquer :: forall a. Alt f a
conquer = f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
#endif
#ifdef GHC_GENERICS
instance Divisible U1 where
divide :: forall a b c. (a -> (b, c)) -> U1 b -> U1 c -> U1 a
divide a -> (b, c)
_ U1 b
U1 U1 c
U1 = U1 a
forall k (p :: k). U1 p
U1
conquer :: forall a. U1 a
conquer = U1 a
forall k (p :: k). U1 p
U1
instance Divisible f => Divisible (Rec1 f) where
divide :: forall a b c. (a -> (b, c)) -> Rec1 f b -> Rec1 f c -> Rec1 f a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l f c
r
conquer :: forall a. Rec1 f a
conquer = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible f => Divisible (M1 i c f) where
divide :: forall a b c.
(a -> (b, c)) -> M1 i c f b -> M1 i c f c -> M1 i c f a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l f c
r
conquer :: forall a. M1 i c f a
conquer = 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
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance (Divisible f, Divisible g) => Divisible (f :*: g) where
divide :: forall a b c.
(a -> (b, c)) -> (:*:) f g b -> (:*:) f g c -> (:*:) f g a
divide a -> (b, c)
f (f b
l1 :*: g b
r1) (f c
l2 :*: g c
r2) = (a -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (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 -> (b, c)) -> g b -> g c -> g a
forall a b c. (a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f g b
r1 g c
r2
conquer :: forall a. (:*:) f g a
conquer = f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
forall a. g a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance (Applicative f, Divisible g) => Divisible (f :.: g) where
divide :: forall a b c.
(a -> (b, c)) -> (:.:) f g b -> (:.:) f g c -> (:.:) f g a
divide a -> (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 ((a -> (b, c)) -> g b -> g c -> g a
forall a b c. (a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f (g b -> g c -> g a) -> f (g b) -> f (g c -> g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g b)
l f (g c -> g a) -> f (g c) -> f (g 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 (g c)
r)
conquer :: forall a. (:.:) f g a
conquer = 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) -> (:.:) f g a) -> f (g a) -> (:.:) f g a
forall a b. (a -> b) -> a -> b
$ g a -> f (g a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure g a
forall a. g a
forall (f :: * -> *) a. Divisible f => f a
conquer
#endif
instance Divisible f => Divisible (Backwards f) where
divide :: forall a b c.
(a -> (b, c)) -> Backwards f b -> Backwards f c -> Backwards f a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l f c
r
conquer :: forall a. Backwards f a
conquer = f a -> Backwards f a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (ExceptT e m) where
divide :: forall a b c.
(a -> (b, c)) -> ExceptT e m b -> ExceptT e m c -> ExceptT e m a
divide a -> (b, c)
f (ExceptT m (Either e b)
l) (ExceptT m (Either e c)
r) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ (Either e a -> (Either e b, Either e c))
-> m (Either e b) -> m (Either e c) -> m (Either e a)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Either e (b, c) -> (Either e b, Either e c)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip (Either e (b, c) -> (Either e b, Either e c))
-> (Either e a -> Either e (b, c))
-> Either e a
-> (Either e b, Either e c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, c)) -> Either e a -> Either e (b, c)
forall a b. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (b, c)
f) m (Either e b)
l m (Either e c)
r
conquer :: forall a. ExceptT e m a
conquer = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT m (Either e a)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible f => Divisible (IdentityT f) where
divide :: forall a b c.
(a -> (b, c)) -> IdentityT f b -> IdentityT f c -> IdentityT f a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l f c
r
conquer :: forall a. IdentityT f a
conquer = f a -> IdentityT f a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (MaybeT m) where
divide :: forall a b c.
(a -> (b, c)) -> MaybeT m b -> MaybeT m c -> MaybeT m a
divide a -> (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.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Maybe (b, c) -> (Maybe b, Maybe c)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip (Maybe (b, c) -> (Maybe b, Maybe c))
-> (Maybe a -> Maybe (b, c)) -> Maybe a -> (Maybe b, Maybe c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, c)) -> Maybe a -> Maybe (b, c)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (b, c)
f) m (Maybe b)
l m (Maybe c)
r
conquer :: forall a. MaybeT m a
conquer = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe a)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (ReaderT r m) where
divide :: forall a b c.
(a -> (b, c)) -> ReaderT r m b -> ReaderT r m c -> ReaderT r m a
divide a -> (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 -> (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.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
abc (r -> m b
rmb r
r) (r -> m c
rmc r
r)
conquer :: forall a. ReaderT r m a
conquer = (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
_ -> m a
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (Lazy.RWST r w s m) where
divide :: forall a b c.
(a -> (b, c)) -> RWST r w s m b -> RWST r w s m c -> RWST r w s m a
divide a -> (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) -> ((b, s, w), (c, s, w)))
-> m (b, s, w) -> m (c, s, w) -> m (a, s, w)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\ ~(a
a, s
s', w
w) -> case a -> (b, c)
abc a
a of
~(b
b, c
c) -> ((b
b, s
s', w
w), (c
c, s
s', w
w)))
(r -> s -> m (b, s, w)
rsmb r
r s
s) (r -> s -> m (c, s, w)
rsmc r
r s
s)
conquer :: forall a. RWST r w s m a
conquer = (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
_ s
_ -> m (a, s, w)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (Strict.RWST r w s m) where
divide :: forall a b c.
(a -> (b, c)) -> RWST r w s m b -> RWST r w s m c -> RWST r w s m a
divide a -> (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) -> ((b, s, w), (c, s, w)))
-> m (b, s, w) -> m (c, s, w) -> m (a, s, w)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\(a
a, s
s', w
w) -> case a -> (b, c)
abc a
a of
(b
b, c
c) -> ((b
b, s
s', w
w), (c
c, s
s', w
w)))
(r -> s -> m (b, s, w)
rsmb r
r s
s) (r -> s -> m (c, s, w)
rsmc r
r s
s)
conquer :: forall a. RWST r w s m a
conquer = (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
_ s
_ -> m (a, s, w)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (Lazy.StateT s m) where
divide :: forall a b c.
(a -> (b, c)) -> StateT s m b -> StateT s m c -> StateT s m a
divide a -> (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) -> ((b, s), (c, s))) -> m (b, s) -> m (c, s) -> m (a, s)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide ((a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
forall a b c s. (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
lazyFanout a -> (b, c)
f) (s -> m (b, s)
l s
s) (s -> m (c, s)
r s
s)
conquer :: forall a. StateT s m a
conquer = (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
_ -> m (a, s)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (Strict.StateT s m) where
divide :: forall a b c.
(a -> (b, c)) -> StateT s m b -> StateT s m c -> StateT s m a
divide a -> (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) -> ((b, s), (c, s))) -> m (b, s) -> m (c, s) -> m (a, s)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide ((a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
forall a b c s. (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
strictFanout a -> (b, c)
f) (s -> m (b, s)
l s
s) (s -> m (c, s)
r s
s)
conquer :: forall a. StateT s m a
conquer = (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
_ -> m (a, s)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (Lazy.WriterT w m) where
divide :: forall a b c.
(a -> (b, c)) -> WriterT w m b -> WriterT w m c -> WriterT w m a
divide a -> (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) -> ((b, w), (c, w))) -> m (b, w) -> m (c, w) -> m (a, w)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide ((a -> (b, c)) -> (a, w) -> ((b, w), (c, w))
forall a b c s. (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
lazyFanout a -> (b, c)
f) m (b, w)
l m (c, w)
r
conquer :: forall a. WriterT w m a
conquer = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT m (a, w)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible m => Divisible (Strict.WriterT w m) where
divide :: forall a b c.
(a -> (b, c)) -> WriterT w m b -> WriterT w m c -> WriterT w m a
divide a -> (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) -> ((b, w), (c, w))) -> m (b, w) -> m (c, w) -> m (a, w)
forall a b c. (a -> (b, c)) -> m b -> m c -> m a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide ((a -> (b, c)) -> (a, w) -> ((b, w), (c, w))
forall a b c s. (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
strictFanout a -> (b, c)
f) m (b, w)
l m (c, w)
r
conquer :: forall a. WriterT w m a
conquer = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT m (a, w)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance (Applicative f, Divisible g) => Divisible (Compose f g) where
divide :: forall a b c.
(a -> (b, c)) -> Compose f g b -> Compose f g c -> Compose f g a
divide a -> (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 ((a -> (b, c)) -> g b -> g c -> g a
forall a b c. (a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f (g b -> g c -> g a) -> f (g b) -> f (g c -> g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g b)
l f (g c -> g a) -> f (g c) -> f (g 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 (g c)
r)
conquer :: forall a. Compose f g a
conquer = 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) -> Compose f g a) -> f (g a) -> Compose f g a
forall a b. (a -> b) -> a -> b
$ g a -> f (g a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure g a
forall a. g a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Monoid m => Divisible (Constant m) where
divide :: forall a b c.
(a -> (b, c)) -> Constant m b -> Constant m c -> Constant m a
divide a -> (b, c)
_ (Constant m
l) (Constant m
r) = m -> Constant m a
forall {k} a (b :: k). a -> Constant a b
Constant (m -> Constant m a) -> m -> Constant m a
forall a b. (a -> b) -> a -> b
$ m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
l m
r
conquer :: forall a. Constant m a
conquer = m -> Constant m a
forall {k} a (b :: k). a -> Constant a b
Constant m
forall a. Monoid a => a
mempty
instance (Divisible f, Divisible g) => Divisible (Product f g) where
divide :: forall a b c.
(a -> (b, c)) -> Product f g b -> Product f g c -> Product f g a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l1 f c
l2) ((a -> (b, c)) -> g b -> g c -> g a
forall a b c. (a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f g b
r1 g c
r2)
conquer :: forall a. Product f g a
conquer = 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
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer g a
forall a. g a
forall (f :: * -> *) a. Divisible f => f a
conquer
instance Divisible f => Divisible (Reverse f) where
divide :: forall a b c.
(a -> (b, c)) -> Reverse f b -> Reverse f c -> Reverse f a
divide a -> (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 -> (b, c)) -> f b -> f c -> f a
forall a b c. (a -> (b, c)) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
l f c
r
conquer :: forall a. Reverse f a
conquer = f a -> Reverse f a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse f a
forall a. f a
forall (f :: * -> *) a. Divisible f => f a
conquer
#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
instance Divisible Proxy where
divide :: forall a b c. (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
divide a -> (b, c)
_ Proxy b
Proxy Proxy c
Proxy = Proxy a
forall {k} (t :: k). Proxy t
Proxy
conquer :: forall a. Proxy a
conquer = Proxy a
forall {k} (t :: k). Proxy t
Proxy
#endif
#ifdef MIN_VERSION_StateVar
instance Divisible SettableStateVar where
divide :: forall a b c.
(a -> (b, c))
-> SettableStateVar b -> SettableStateVar c -> SettableStateVar a
divide a -> (b, c)
k (SettableStateVar b -> IO ()
l) (SettableStateVar c -> IO ()
r) = (a -> IO ()) -> SettableStateVar a
forall a. (a -> IO ()) -> SettableStateVar a
SettableStateVar ((a -> IO ()) -> SettableStateVar a)
-> (a -> IO ()) -> SettableStateVar a
forall a b. (a -> b) -> a -> b
$ \ a
a -> case a -> (b, c)
k a
a of
(b
b, c
c) -> b -> IO ()
l b
b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> IO ()
r c
c
conquer :: forall a. SettableStateVar a
conquer = (a -> IO ()) -> SettableStateVar a
forall a. (a -> IO ()) -> SettableStateVar a
SettableStateVar ((a -> IO ()) -> SettableStateVar a)
-> (a -> IO ()) -> SettableStateVar a
forall a b. (a -> b) -> a -> b
$ \a
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
lazyFanout :: (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
lazyFanout :: forall a b c s. (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
lazyFanout a -> (b, c)
f ~(a
a, s
s) = case a -> (b, c)
f a
a of
~(b
b, c
c) -> ((b
b, s
s), (c
c, s
s))
strictFanout :: (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
strictFanout :: forall a b c s. (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
strictFanout a -> (b, c)
f (a
a, s
s) = case a -> (b, c)
f a
a of
(b
b, c
c) -> ((b
b, s
s), (c
c, s
s))
funzip :: Functor f => f (a, b) -> (f a, f b)
funzip :: forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip = ((a, b) -> a) -> f (a, b) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (f (a, b) -> f a) -> (f (a, b) -> f b) -> f (a, b) -> (f a, f b)
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')
&&& ((a, b) -> b) -> f (a, b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd
class Divisible f => Decidable f where
lose :: (a -> Void) -> f a
choose :: (a -> Either b c) -> f b -> f c -> f a
lost :: Decidable f => f Void
lost :: forall (f :: * -> *). Decidable f => f Void
lost = (Void -> Void) -> f Void
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose Void -> Void
forall a. a -> a
id
chosen :: Decidable f => f b -> f c -> f (Either b c)
chosen :: forall (f :: * -> *) b c.
Decidable f =>
f b -> f c -> f (Either b c)
chosen = (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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose Either b c -> Either b c
forall a. a -> a
id
instance Decidable Comparison where
lose :: forall a. (a -> Void) -> Comparison a
lose a -> Void
f = (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
_ -> Void -> Ordering
forall a. Void -> a
absurd (a -> Void
f a
a)
choose :: forall a b c.
(a -> Either b c) -> Comparison b -> Comparison c -> Comparison a
choose 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
instance Decidable Equivalence where
lose :: forall a. (a -> Void) -> Equivalence a
lose a -> Void
f = (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
$ Void -> a -> Bool
forall a. Void -> a
absurd (Void -> a -> Bool) -> (a -> Void) -> a -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Void
f
choose :: forall a b c.
(a -> Either b c)
-> Equivalence b -> Equivalence c -> Equivalence a
choose 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
instance Decidable Predicate where
lose :: forall a. (a -> Void) -> Predicate a
lose a -> Void
f = (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
$ Void -> Bool
forall a. Void -> a
absurd (Void -> Bool) -> (a -> Void) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Void
f
choose :: forall a b c.
(a -> Either b c) -> Predicate b -> Predicate c -> Predicate a
choose 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
instance Monoid r => Decidable (Op r) where
lose :: forall a. (a -> Void) -> Op r a
lose a -> Void
f = (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
$ Void -> r
forall a. Void -> a
absurd (Void -> r) -> (a -> Void) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Void
f
choose :: forall a b c. (a -> Either b c) -> Op r b -> Op r c -> Op r a
choose 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)
instance Decidable f => Decidable (Alt f) where
lose :: forall a. (a -> Void) -> Alt f a
lose = f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f a -> Alt f a) -> ((a -> Void) -> f a) -> (a -> Void) -> Alt f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c. (a -> Either b c) -> Alt f b -> Alt f c -> Alt f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f f b
l f c
r
#endif
#ifdef GHC_GENERICS
instance Decidable U1 where
lose :: forall a. (a -> Void) -> U1 a
lose a -> Void
_ = U1 a
forall k (p :: k). U1 p
U1
choose :: forall a b c. (a -> Either b c) -> U1 b -> U1 c -> U1 a
choose a -> Either b c
_ U1 b
U1 U1 c
U1 = U1 a
forall k (p :: k). U1 p
U1
instance Decidable f => Decidable (Rec1 f) where
lose :: forall a. (a -> Void) -> Rec1 f a
lose = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f a -> Rec1 f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> Rec1 f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c. (a -> Either b c) -> Rec1 f b -> Rec1 f c -> Rec1 f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f f b
l f c
r
instance Decidable f => Decidable (M1 i c f) where
lose :: forall a. (a -> Void) -> M1 i c f a
lose = 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)
-> ((a -> Void) -> f a) -> (a -> Void) -> M1 i c f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c.
(a -> Either b c) -> M1 i c f b -> M1 i c f c -> M1 i c f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f f b
l f c
r
instance (Decidable f, Decidable g) => Decidable (f :*: g) where
lose :: forall a. (a -> Void) -> (:*:) f g a
lose a -> Void
f = (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> Void) -> g a
forall a. (a -> Void) -> g a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f
choose :: forall a b c.
(a -> Either b c) -> (:*:) f g b -> (:*:) f g c -> (:*:) f g a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f g b
r1 g c
r2
instance (Applicative f, Decidable g) => Decidable (f :.: g) where
lose :: forall a. (a -> Void) -> (:.:) f g a
lose = 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) -> (:.:) f g a)
-> ((a -> Void) -> f (g a)) -> (a -> Void) -> (:.:) f g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> f (g a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (g a -> f (g a)) -> ((a -> Void) -> g a) -> (a -> Void) -> f (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> g a
forall a. (a -> Void) -> g a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c.
(a -> Either b c) -> (:.:) f g b -> (:.:) f g c -> (:.:) f g a
choose 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 ((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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f (g b -> g c -> g a) -> f (g b) -> f (g c -> g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g b)
l f (g c -> g a) -> f (g c) -> f (g 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 (g c)
r)
#endif
instance Decidable f => Decidable (Backwards f) where
lose :: forall a. (a -> Void) -> Backwards f a
lose = f a -> Backwards f a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f a -> Backwards f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> Backwards f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c.
(a -> Either b c)
-> Backwards f b -> Backwards f c -> Backwards f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f f b
l f c
r
instance Decidable f => Decidable (IdentityT f) where
lose :: forall a. (a -> Void) -> IdentityT f a
lose = f a -> IdentityT f a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (f a -> IdentityT f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> IdentityT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c.
(a -> Either b c)
-> IdentityT f b -> IdentityT f c -> IdentityT f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f f b
l f c
r
instance Decidable m => Decidable (ReaderT r m) where
lose :: forall a. (a -> Void) -> ReaderT r m a
lose a -> Void
f = (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
_ -> (a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f
choose :: forall a b c.
(a -> Either b c)
-> ReaderT r m b -> ReaderT r m c -> ReaderT r m a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
abc (r -> m b
rmb r
r) (r -> m c
rmc r
r)
instance Decidable m => Decidable (Lazy.RWST r w s m) where
lose :: forall a. (a -> Void) -> RWST r w s m a
lose a -> Void
f = (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
_ s
_ -> ((a, s, w) -> a) -> m a -> m (a, s, w)
forall a' a. (a' -> a) -> m a -> m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\ ~(a
a, s
_, w
_) -> a
a) ((a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: 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
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (\ ~(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)
instance Decidable m => Decidable (Strict.RWST r w s m) where
lose :: forall a. (a -> Void) -> RWST r w s m a
lose a -> Void
f = (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
_ s
_ -> ((a, s, w) -> a) -> m a -> m (a, s, w)
forall a' a. (a' -> a) -> m a -> m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\(a
a, s
_, w
_) -> a
a) ((a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: 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
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (\(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))
instance Divisible m => Divisible (ErrorT e m) where
divide f (ErrorT l) (ErrorT r) = ErrorT $ divide (funzip . fmap f) l r
conquer = ErrorT conquer
instance Divisible m => Divisible (ListT m) where
divide f (ListT l) (ListT r) = ListT $ divide (funzip . map f) l r
conquer = ListT conquer
instance Divisible m => Decidable (ListT m) where
lose _ = ListT conquer
choose f (ListT l) (ListT r) = ListT $ divide ((lefts &&& rights) . map f) l r
#endif
instance Divisible m => Decidable (MaybeT m) where
lose :: forall a. (a -> Void) -> MaybeT m a
lose a -> Void
_ = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe a)
forall a. m a
forall (f :: * -> *) a. Divisible f => f a
conquer
choose :: forall a b c.
(a -> Either b c) -> MaybeT m b -> MaybeT m c -> MaybeT m a
choose 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.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide ( (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
instance Decidable m => Decidable (Lazy.StateT s m) where
lose :: forall a. (a -> Void) -> StateT s m a
lose a -> Void
f = (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
_ -> ((a, s) -> a) -> m a -> m (a, s)
forall a' a. (a' -> a) -> m a -> m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (a, s) -> a
forall a b. (a, b) -> a
lazyFst ((a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: forall a b c.
(a -> Either b c) -> StateT s m b -> StateT s m c -> StateT s m a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (\ ~(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)
instance Decidable m => Decidable (Strict.StateT s m) where
lose :: forall a. (a -> Void) -> StateT s m a
lose a -> Void
f = (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
_ -> ((a, s) -> a) -> m a -> m (a, s)
forall a' a. (a' -> a) -> m a -> m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (a, s) -> a
forall a b. (a, b) -> a
fst ((a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: forall a b c.
(a -> Either b c) -> StateT s m b -> StateT s m c -> StateT s m a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (\(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)
instance Decidable m => Decidable (Lazy.WriterT w m) where
lose :: forall a. (a -> Void) -> WriterT w m a
lose a -> Void
f = 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) -> a) -> m a -> m (a, w)
forall a' a. (a' -> a) -> m a -> m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (a, w) -> a
forall a b. (a, b) -> a
lazyFst ((a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: forall a b c.
(a -> Either b c)
-> WriterT w m b -> WriterT w m c -> WriterT w m a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (\ ~(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
instance Decidable m => Decidable (Strict.WriterT w m) where
lose :: forall a. (a -> Void) -> WriterT w m a
lose a -> Void
f = 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) -> a) -> m a -> m (a, w)
forall a' a. (a' -> a) -> m a -> m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (a, w) -> a
forall a b. (a, b) -> a
fst ((a -> Void) -> m a
forall a. (a -> Void) -> m a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: forall a b c.
(a -> Either b c)
-> WriterT w m b -> WriterT w m c -> WriterT w m a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (\(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
instance (Applicative f, Decidable g) => Decidable (Compose f g) where
lose :: forall a. (a -> Void) -> Compose f g a
lose = 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) -> Compose f g a)
-> ((a -> Void) -> f (g a)) -> (a -> Void) -> Compose f g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> f (g a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (g a -> f (g a)) -> ((a -> Void) -> g a) -> (a -> Void) -> f (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> g a
forall a. (a -> Void) -> g a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c.
(a -> Either b c)
-> Compose f g b -> Compose f g c -> Compose f g a
choose 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 ((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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f (g b -> g c -> g a) -> f (g b) -> f (g c -> g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g b)
l f (g c -> g a) -> f (g c) -> f (g 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 (g c)
r)
instance (Decidable f, Decidable g) => Decidable (Product f g) where
lose :: forall a. (a -> Void) -> Product f g a
lose a -> Void
f = 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 -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f) ((a -> Void) -> g a
forall a. (a -> Void) -> g a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
choose :: forall a b c.
(a -> Either b c)
-> Product f g b -> Product f g c -> Product f g a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
f g b
r1 g c
r2)
instance Decidable f => Decidable (Reverse f) where
lose :: forall a. (a -> Void) -> Reverse f a
lose = f a -> Reverse f a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a -> Reverse f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> Reverse f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
choose :: forall a b c.
(a -> Either b c) -> Reverse f b -> Reverse f c -> Reverse f a
choose 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.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose 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)
lazyFst :: (a, b) -> a
lazyFst :: forall a b. (a, b) -> a
lazyFst ~(a
a, b
_) = a
a
#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
instance Decidable Proxy where
lose :: forall a. (a -> Void) -> Proxy a
lose a -> Void
_ = Proxy a
forall {k} (t :: k). Proxy t
Proxy
choose :: forall a b c. (a -> Either b c) -> Proxy b -> Proxy c -> Proxy a
choose a -> Either b c
_ Proxy b
Proxy Proxy c
Proxy = Proxy a
forall {k} (t :: k). Proxy t
Proxy
#endif
#ifdef MIN_VERSION_StateVar
instance Decidable SettableStateVar where
lose :: forall a. (a -> Void) -> SettableStateVar a
lose a -> Void
k = (a -> IO ()) -> SettableStateVar a
forall a. (a -> IO ()) -> SettableStateVar a
SettableStateVar (Void -> IO ()
forall a. Void -> a
absurd (Void -> IO ()) -> (a -> Void) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Void
k)
choose :: forall a b c.
(a -> Either b c)
-> SettableStateVar b -> SettableStateVar c -> SettableStateVar a
choose a -> Either b c
k (SettableStateVar b -> IO ()
l) (SettableStateVar c -> IO ()
r) = (a -> IO ()) -> SettableStateVar a
forall a. (a -> IO ()) -> SettableStateVar a
SettableStateVar ((a -> IO ()) -> SettableStateVar a)
-> (a -> IO ()) -> SettableStateVar a
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