{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if MIN_VERSION_base(4,7,0)
{-# LANGUAGE EmptyCase #-}
#endif
module Data.Functor.Contravariant.Divise (
Divise(..)
, divised
, WrappedDivisible(..)
) 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.Apply
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Functor.Product
import Data.Functor.Reverse
#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Monoid (Alt(..))
#else
import Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup(..))
#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 => Divise f where
divise :: (a -> (b, c)) -> f b -> f c -> f a
divised :: Divise f => f a -> f b -> f (a, b)
divised :: f a -> f b -> f (a, b)
divised = ((a, b) -> (a, b)) -> f a -> f b -> f (a, b)
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (a, b) -> (a, b)
forall a. a -> a
id
newtype WrappedDivisible f a = WrapDivisible { WrappedDivisible f a -> f a
unwrapDivisible :: f a }
instance Contravariant f => Contravariant (WrappedDivisible f) where
contramap :: (a -> b) -> WrappedDivisible f b -> WrappedDivisible f a
contramap a -> b
f (WrapDivisible f b
a) = f a -> WrappedDivisible f a
forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible ((a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f f b
a)
instance Divisible f => Divise (WrappedDivisible f) where
divise :: (a -> (b, c))
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
divise a -> (b, c)
f (WrapDivisible f b
x) (WrapDivisible f c
y) = f a -> WrappedDivisible f a
forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible ((a -> (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
x f c
y)
#if MIN_VERSION_base(4,9,0)
instance Semigroup r => Divise (Op r) where
divise :: (a -> (b, c)) -> Op r b -> Op r c -> Op r a
divise 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. Semigroup a => a -> a -> a
<> c -> r
h c
c
instance Semigroup m => Divise (Const m) where
divise :: (a -> (b, c)) -> Const m b -> Const m c -> Const m a
divise a -> (b, c)
_ (Const m
a) (Const m
b) = m -> Const m a
forall k a (b :: k). a -> Const a b
Const (m
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
b)
instance Semigroup m => Divise (Constant m) where
divise :: (a -> (b, c)) -> Constant m b -> Constant m c -> Constant m a
divise a -> (b, c)
_ (Constant m
a) (Constant m
b) = m -> Constant m a
forall k a (b :: k). a -> Constant a b
Constant (m
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
b)
#else
instance Monoid r => Divise (Op r) where divise = divide
instance Monoid m => Divise (Const m) where divise = divide
instance Monoid m => Divise (Constant m) where divise = divide
#endif
instance Divise Comparison where divise :: (a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
divise = (a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
instance Divise Equivalence where divise :: (a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
divise = (a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
instance Divise Predicate where divise :: (a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
divise = (a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
instance Divise Proxy where divise :: (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
divise = (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
#endif
#ifdef MIN_VERSION_StateVar
instance Divise SettableStateVar where divise = divide
#endif
#if MIN_VERSION_base(4,8,0)
instance Divise f => Divise (Alt f) where
divise :: (a -> (b, c)) -> Alt f b -> Alt f c -> Alt f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l f c
r
#endif
#ifdef GHC_GENERICS
instance Divise U1 where divise :: (a -> (b, c)) -> U1 b -> U1 c -> U1 a
divise = (a -> (b, c)) -> U1 b -> U1 c -> U1 a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
#if MIN_VERSION_base(4,7,0)
instance Divise V1 where divise :: (a -> (b, c)) -> V1 b -> V1 c -> V1 a
divise a -> (b, c)
_ V1 b
x = case V1 b
x of {}
#else
instance Divise V1 where divise _ !_ = error "V1"
#endif
instance Divise f => Divise (Rec1 f) where
divise :: (a -> (b, c)) -> Rec1 f b -> Rec1 f c -> Rec1 f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l f c
r
instance Divise f => Divise (M1 i c f) where
divise :: (a -> (b, c)) -> M1 i c f b -> M1 i c f c -> M1 i c f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l f c
r
instance (Divise f, Divise g) => Divise (f :*: g) where
divise :: (a -> (b, c)) -> (:*:) f g b -> (:*:) f g c -> (:*:) f g a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f g b
r1 g c
r2
instance (Apply f, Divise g) => Divise (f :.: g) where
divise :: (a -> (b, c)) -> (:.:) f g b -> (:.:) f g c -> (:.:) f g a
divise 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 ((g b -> g c -> g a) -> f (g b) -> f (g c) -> f (g a)
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 ((a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f) f (g b)
l f (g c)
r)
#endif
instance Divise f => Divise (Backwards f) where
divise :: (a -> (b, c)) -> Backwards f b -> Backwards f c -> Backwards f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l f c
r
#if !(MIN_VERSION_transformers(0,6,0))
instance Divise m => Divise (ErrorT e m) where
divise :: (a -> (b, c)) -> ErrorT e m b -> ErrorT e m c -> ErrorT e m a
divise a -> (b, c)
f (ErrorT m (Either e b)
l) (ErrorT m (Either e c)
r) = m (Either e a) -> ErrorT e m a
forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e a) -> ErrorT e m a) -> m (Either e a) -> ErrorT 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 (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
instance Divise m => Divise (ListT m) where
divise :: (a -> (b, c)) -> ListT m b -> ListT m c -> ListT m a
divise a -> (b, c)
f (ListT m [b]
l) (ListT m [c]
r) = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a) -> m [a] -> ListT m a
forall a b. (a -> b) -> a -> b
$ ([a] -> ([b], [c])) -> m [b] -> m [c] -> m [a]
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ([(b, c)] -> ([b], [c])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip ([(b, c)] -> ([b], [c])) -> ([a] -> [(b, c)]) -> [a] -> ([b], [c])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, c)) -> [a] -> [(b, c)]
forall a b. (a -> b) -> [a] -> [b]
map a -> (b, c)
f) m [b]
l m [c]
r
#endif
instance Divise m => Divise (ExceptT e m) where
divise :: (a -> (b, c)) -> ExceptT e m b -> ExceptT e m c -> ExceptT e m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 (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
instance Divise f => Divise (IdentityT f) where
divise :: (a -> (b, c)) -> IdentityT f b -> IdentityT f c -> IdentityT f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l f c
r
instance Divise m => Divise (MaybeT m) where
divise :: (a -> (b, c)) -> MaybeT m b -> MaybeT m c -> MaybeT m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (b, c)
f) m (Maybe b)
l m (Maybe c)
r
instance Divise m => Divise (ReaderT r m) where
divise :: (a -> (b, c)) -> ReaderT r m b -> ReaderT r m c -> ReaderT r m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
abc (r -> m b
rmb r
r) (r -> m c
rmc r
r)
instance Divise m => Divise (Lazy.RWST r w s m) where
divise :: (a -> (b, c)) -> RWST r w s m b -> RWST r w s m c -> RWST r w s m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (\ ~(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)
instance Divise m => Divise (Strict.RWST r w s m) where
divise :: (a -> (b, c)) -> RWST r w s m b -> RWST r w s m c -> RWST r w s m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (\(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)
instance Divise m => Divise (Lazy.StateT s m) where
divise :: (a -> (b, c)) -> StateT s m b -> StateT s m c -> StateT s m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ((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)
instance Divise m => Divise (Strict.StateT s m) where
divise :: (a -> (b, c)) -> StateT s m b -> StateT s m c -> StateT s m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ((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)
instance Divise m => Divise (Lazy.WriterT w m) where
divise :: (a -> (b, c)) -> WriterT w m b -> WriterT w m c -> WriterT w m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ((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
instance Divise m => Divise (Strict.WriterT w m) where
divise :: (a -> (b, c)) -> WriterT w m b -> WriterT w m c -> WriterT w m a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise ((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
instance (Apply f, Divise g) => Divise (Compose f g) where
divise :: (a -> (b, c)) -> Compose f g b -> Compose f g c -> Compose f g a
divise 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 ((g b -> g c -> g a) -> f (g b) -> f (g c) -> f (g a)
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 ((a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f) f (g b)
l f (g c)
r)
instance (Divise f, Divise g) => Divise (Product f g) where
divise :: (a -> (b, c)) -> Product f g b -> Product f g c -> Product f g a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l1 f c
l2) ((a -> (b, c)) -> g b -> g c -> g a
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f g b
r1 g c
r2)
instance Divise f => Divise (Reverse f) where
divise :: (a -> (b, c)) -> Reverse f b -> Reverse f c -> Reverse f a
divise 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 (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f f b
l f c
r
lazyFanout :: (a -> (b, c)) -> (a, s) -> ((b, s), (c, s))
lazyFanout :: (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 :: (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 :: f (a, b) -> (f a, f b)
funzip = ((a, b) -> a) -> f (a, b) -> f a
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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd