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

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2021 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
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

-- | The contravariant analogue of 'Apply'; it is
-- 'Divisible' without 'conquer'.
--
-- If one thinks of @f a@ as a consumer of @a@s, then 'divise' allows one
-- to handle the consumption of a value by splitting it between two
-- consumers that consume separate parts of @a@.
--
-- 'divise' takes the \"splitting\" method and the two sub-consumers, and
-- returns the wrapped/combined consumer.
--
-- All instances of 'Divisible' should be instances of 'Divise' with
-- @'divise' = 'divide'@.
--
-- If a function is polymorphic over @'Divise' f@ (as opposed to @'Divisible'
-- f@), we can provide a stronger guarantee: namely, that any input consumed
-- will be passed to at least one sub-consumer. With @'Divisible' f@, said input
-- could potentially disappear into the void, as this is possible with
-- 'conquer'.
--
-- Mathematically, a functor being an instance of 'Divise' means that it is
-- \"semigroupoidal\" with respect to the contravariant (tupling) Day
-- convolution.  That is, it is possible to define a function @(f `Day` f)
-- a -> f a@ in a way that is associative.
--
-- @since 5.3.6
class Contravariant f => Divise f where
    -- | Takes a \"splitting\" method and the two sub-consumers, and
    -- returns the wrapped/combined consumer.
    divise :: (a -> (b, c)) -> f b -> f c -> f a

-- | Combine a consumer of @a@ with a consumer of @b@ to get a consumer of
-- @(a, b)@.
--
-- @
-- 'divised' = 'divise' 'id'
-- @
--
-- @since 5.3.6
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

-- | Wrap a 'Divisible' to be used as a member of 'Divise'
--
-- @since 5.3.6
newtype WrappedDivisible f a = WrapDivisible { WrappedDivisible f a -> f a
unwrapDivisible :: f a }

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

-- | @since 5.3.6
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)
-- | Unlike 'Divisible', requires only 'Semigroup' on @r@.
--
-- @since 5.3.6
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

-- | Unlike 'Divisible', requires only 'Semigroup' on @m@.
--
-- @since 5.3.6
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)

-- | Unlike 'Divisible', requires only 'Semigroup' on @m@.
--
-- @since 5.3.6
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
-- | @since 5.3.6
instance Monoid r => Divise (Op r) where divise = divide

-- | @since 5.3.6
instance Monoid m => Divise (Const m) where divise = divide

-- | @since 5.3.6
instance Monoid m => Divise (Constant m) where divise = divide
#endif

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

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

-- | @since 5.3.6
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)
-- | @since 5.3.6
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
-- | @since 5.3.6
instance Divise SettableStateVar where divise = divide
#endif

#if MIN_VERSION_base(4,8,0)
-- | @since 5.3.6
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
-- | @since 5.3.6
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

-- | Has no 'Divisible' instance.
--
-- @since 5.3.6
#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

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

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

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

-- | Unlike 'Divisible', requires only 'Apply' on @f@.
--
-- @since 5.3.6
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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Unlike 'Divisible', requires only 'Apply' on @f@.
--
-- @since 5.3.6
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)

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

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

-- Helpers

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