{-# 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
--
-- This module is only available if building with GHC 8.6 or later, or if the
-- @+contravariant@ @cabal@ build flag is available.
----------------------------------------------------------------------------
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.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

#if defined(MIN_VERSION_contravariant)
import Data.Functor.Contravariant.Divisible
#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 = Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f a -> f a) -> Rep1 f a -> f a
forall a b. (a -> b) -> a -> b
$ (a -> (b, c)) -> Rep1 f b -> Rep1 f c -> Rep1 f a
forall a b c. (a -> (b, c)) -> Rep1 f b -> Rep1 f c -> Rep1 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 -> Rep1 f b
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
x) (f c -> Rep1 f c
forall a. f a -> Rep1 f a
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 = ((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.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (a, b) -> (a, b)
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 = ((a, b) -> (a, b)) -> f a -> f b -> f (a, b)
forall (f :: * -> *) a b c.
(Divise (Rep1 f), Generic1 f) =>
(a -> (b, c)) -> f b -> f c -> f a
gdivise (a, b) -> (a, b)
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) = f a' -> WrappedDivisible f a'
forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible ((a' -> a) -> f a -> f a'
forall a' a. (a' -> a) -> f a -> f a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f f a
a)

#if defined(MIN_VERSION_contravariant)
-- | This instance is only available if the @+contravariant@ @cabal@ flag is
-- enabled.
--
-- @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) = f a -> WrappedDivisible f a
forall (f :: * -> *) a. f a -> WrappedDivisible f a
WrapDivisible ((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
x f c
y)
#endif

-- | 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) = (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 :: 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) = 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 :: 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) = 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)

-- | @since 5.3.6
instance Divise Comparison where
  divise :: forall a b c.
(a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
divise 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''

-- | @since 5.3.6
instance Divise Equivalence where
  divise :: forall a b c.
(a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
divise 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''

-- | @since 5.3.6
instance Divise Predicate where
  divise :: forall a b c.
(a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
divise 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

-- | @since 5.3.6
instance Divise Proxy where
  divise :: forall a b c. (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
divise a -> (b, c)
_ Proxy b
Proxy Proxy c
Proxy = Proxy a
forall {k} (t :: k). Proxy t
Proxy

#ifdef MIN_VERSION_StateVar
-- | @since 5.3.6
instance Divise SettableStateVar where
  divise k (SettableStateVar l) (SettableStateVar r) = SettableStateVar $ \ a -> case k a of
    (b, c) -> l b >> r c
#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) = 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.
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 a -> (b, c)
_ U1 b
U1 U1 c
U1 = U1 a
forall k (p :: k). U1 p
U1

-- | 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) = 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.
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) = 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.
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) = (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.
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 a b c. (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 :: 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) = 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 a b c. (a -> b -> c) -> f a -> f b -> f c
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 a b c. (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 (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) = 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.
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 f (ErrorT l) (ErrorT r) = ErrorT $ divise (funzip . fmap f) l r

-- | @since 5.3.6
instance Divise m => Divise (ListT m) where
  divise f (ListT l) (ListT r) = ListT $ divise (funzip . map f) l 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) = 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.
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 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

-- | @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) = 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.
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) = 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.
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 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

-- | @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) = (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.
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) = (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.
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) = (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.
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) = (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.
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 :: 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) = (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.
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 :: 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) = 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.
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 :: 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) = 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.
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 :: 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) = 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 a b c. (a -> b -> c) -> f a -> f b -> f c
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 a b c. (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 :: 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) = 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.
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 a b c. (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 :: 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) = 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.
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 = ((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