{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE CPP           #-}
{-# LANGUAGE EmptyCase     #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}

-----------------------------------------------------------------------------

-- |

-- 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(..)
  , gdivise
  , divised
  , gdivised
  , 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
import Data.Monoid (Alt(..))
import Data.Proxy
import GHC.Generics

#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif

#if !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup(..))
#endif

#ifdef MIN_VERSION_StateVar
import Data.StateVar
#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

-- | Generic 'divise'. Caveats:

--

--   1. Will not compile if @f@ is a sum type.

--   2. Will not compile if @f@ contains fields that do not mention its type variable.

--   3. @-XDeriveGeneric@ is not smart enough to make instances where the type variable appears in negative position.

--

-- @since 5.3.8

gdivise :: (Divise (Rep1 f), Generic1 f) => (a -> (b, c)) -> f b -> f c -> f a
gdivise :: forall (f :: * -> *) a b c.
(Divise (Rep1 f), Generic1 f) =>
(a -> (b, c)) -> f b -> f c -> f a
gdivise a -> (b, c)
f f b
x f c
y = forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise a -> (b, c)
f (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
x) (forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f c
y)

-- | 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 :: forall (f :: * -> *) a b. Divise f => f a -> f b -> f (a, b)
divised = forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise forall a. a -> a
id

-- | Generic 'divised'. Caveats are the same as for 'gdivise'.

--

-- @since 5.3.8

gdivised :: (Generic1 f, Divise (Rep1 f)) => f a -> f b -> f (a, b)
gdivised :: forall (f :: * -> *) a b.
(Generic1 f, Divise (Rep1 f)) =>
f a -> f b -> f (a, b)
gdivised f a
fa f b
fb = forall (f :: * -> *) a b c.
(Divise (Rep1 f), Generic1 f) =>
(a -> (b, c)) -> f b -> f c -> f a
gdivise forall a. a -> a
id f a
fa f b
fb

-- | Wrap a 'Divisible' to be used as a member of 'Divise'

--

-- @since 5.3.6

newtype WrappedDivisible f a = WrapDivisible { forall (f :: * -> *) a. WrappedDivisible f a -> f a
unwrapDivisible :: f a }

-- | @since 5.3.6

instance Contravariant f => Contravariant (WrappedDivisible f) where
  contramap :: forall a' a.
(a' -> a) -> WrappedDivisible f a -> WrappedDivisible f a'
contramap a' -> a
f (WrapDivisible f a
a) = forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f f a
a)

-- | @since 5.3.6

instance Divisible f => Divise (WrappedDivisible f) where
  divise :: forall a b c.
(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) = forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible (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)

-- | Unlike 'Divisible', requires only 'Semigroup' on @r@.

--

-- @since 5.3.6

instance Semigroup r => Divise (Op r) where
    divise :: forall a b c. (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) = forall a b. (b -> a) -> Op a b
Op 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 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 :: forall a b c. (a -> (b, c)) -> Const m b -> Const m c -> Const m a
divise a -> (b, c)
_ (Const m
a) (Const m
b) = forall {k} a (b :: k). a -> Const a b
Const (m
a 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 :: forall a b c.
(a -> (b, c)) -> Constant m b -> Constant m c -> Constant m a
divise a -> (b, c)
_ (Constant m
a) (Constant m
b) = forall {k} a (b :: k). a -> Constant a b
Constant (m
a forall a. Semigroup a => a -> a -> a
<> m
b)

-- | @since 5.3.6

instance Divise Comparison where divise :: forall a b c.
(a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
divise = 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 :: forall a b c.
(a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
divise = 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 :: forall a b c.
(a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
divise = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide

-- | @since 5.3.6

instance Divise Proxy where divise :: forall a b c. (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
divise = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide

#ifdef MIN_VERSION_StateVar
-- | @since 5.3.6

instance Divise SettableStateVar where divise = divide
#endif

-- | @since 5.3.6

instance Divise f => Divise (Alt f) where
  divise :: forall a b c. (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) = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt forall a b. (a -> b) -> a -> b
$ 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 U1 where divise :: forall a b c. (a -> (b, c)) -> U1 b -> U1 c -> U1 a
divise = 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

instance Divise V1 where divise :: forall a b c. (a -> (b, c)) -> V1 b -> V1 c -> V1 a
divise a -> (b, c)
_ V1 b
x = case V1 b
x of {}

-- | @since 5.3.6

instance Divise f => Divise (Rec1 f) where
  divise :: forall a b c. (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) = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall a b. (a -> b) -> a -> b
$ 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 :: forall a b c.
(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) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
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 :: forall a b c.
(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) = 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 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: 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 :: forall a b c.
(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) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (forall (f :: * -> *) a b c.
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 (Backwards f) where
  divise :: forall a b c.
(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) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall a b. (a -> b) -> a -> b
$ 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 :: forall a b c.
(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) = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip forall b c a. (b -> c) -> (a -> b) -> a -> 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 :: forall a b c. (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) = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip forall b c a. (b -> c) -> (a -> b) -> a -> 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 :: forall a b c.
(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) = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip forall b c a. (b -> c) -> (a -> b) -> a -> 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 :: forall a b c.
(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) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ 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 :: forall a b c.
(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) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
funzip forall b c a. (b -> c) -> (a -> b) -> a -> 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 :: forall a b c.
(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) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (f :: * -> *) a b c.
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 :: 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
divise a -> (b, c)
abc (Lazy.RWST r -> s -> m (b, s, w)
rsmb) (Lazy.RWST r -> s -> m (c, s, w)
rsmc) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    forall (f :: * -> *) a b c.
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 :: 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
divise a -> (b, c)
abc (Strict.RWST r -> s -> m (b, s, w)
rsmb) (Strict.RWST r -> s -> m (c, s, w)
rsmc) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
    forall (f :: * -> *) a b c.
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 :: forall a b c.
(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) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s ->
    forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 :: forall a b c.
(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) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s ->
    forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 :: forall a b c.
(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) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 :: forall a b c.
(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) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (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 :: forall a b c.
(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) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (forall (f :: * -> *) a b c.
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 :: forall a b c.
(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) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (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) (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 :: forall a b c.
(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) = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall a b. (a -> b) -> a -> b
$ 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 :: 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd