{-# LANGUAGE CPP                  #-}
{-# LANGUAGE TypeOperators        #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

-- |
-- Module      : Data.Functor.Contravariant.Divise
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- The contravariant counterpart of 'Apply': like 'Divisible', but without
-- 'conquer'.  This is only a part of this library currently for
-- compatibility, until it is (hopefully) merged into /semigroupoids/.
--
-- @since 0.3.0.0
module Data.Functor.Contravariant.Divise (
    Divise(..)
  , (<:>)
  , dsum1
  , 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           Control.Monad.Trans.Reader
import           Data.Deriving
import           Data.Functor.Apply
import           Data.Functor.Compose
import           Data.Functor.Constant
import           Data.Functor.Contravariant
import           Data.Functor.Contravariant.Divisible
import           Data.Functor.Invariant
import           Data.Functor.Product
import           Data.Functor.Reverse
import qualified Control.Monad.Trans.RWS.Lazy         as Lazy
import qualified Control.Monad.Trans.RWS.Strict       as Strict
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 qualified Data.Semigroup.Foldable              as F1

#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

#if !MIN_VERSION_transformers(0,6,0)
import           Control.Monad.Trans.Error
import           Control.Monad.Trans.List
#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'@.
--
-- The guarantee that a function polymorphic over of @'Divise' f@ provides
-- that @'Divisible' f@ doesn't that any input consumed will be passed to at
-- least one sub-consumer; it won't potentially disappear into the void, as
-- is possible if 'conquer' is available.
--
-- Mathematically, a functor being an instance of 'Divise' means that it is
-- "semgroupoidal" 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.
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
    divise a -> (b, c)
f f b
x f c
y = (a -> (b, c)) -> f (b, c) -> 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 -> (b, c)
f (f b -> f c -> f (b, c)
forall a b. f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Divise f => f a -> f b -> f (a, b)
divised f b
x f c
y)
    -- | Combine a consumer of @a@ with a consumer of @b@ to get a consumer
    -- of @(a, b)@.
    divised :: 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
    {-# MINIMAL divise | divised #-}

-- | The Contravariant version of '<|>': split the same input over two
-- different consumers.
(<:>) :: Divise f => f a -> f a -> f a
f a
x <:> :: forall (f :: * -> *) a. Divise f => f a -> f a -> f a
<:> f a
y = (a -> (a, a)) -> f a -> f a -> 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
r -> (a
r,a
r)) f a
x f a
y

-- | Convenient helper function to build up a 'Divise' by splitting
-- input across many different @f a@s.  Most useful when used alongside
-- 'contramap':
--
-- @
-- dsum1 $ contramap get1 x
--    :| [ contramap get2 y
--       , contramap get3 z
--       ]
-- @
--
-- @since 0.3.3.0
dsum1 :: (F1.Foldable1 t, Divise f) => t (f a) -> f a
dsum1 :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable1 t, Divise f) =>
t (f a) -> f a
dsum1 = (f a -> f a -> f a) -> NonEmpty (f a) -> f a
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 f a -> f a -> f a
forall (f :: * -> *) a. Divise f => f a -> f a -> f a
(<:>) (NonEmpty (f a) -> f a)
-> (t (f a) -> NonEmpty (f a)) -> t (f a) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (f a) -> NonEmpty (f a)
forall a. t a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty

-- | Wrap a 'Divisible' to be used as a member of 'Divise'
newtype WrappedDivisible f a = WrapDivisible { forall {k} (f :: k -> *) (a :: k). WrappedDivisible f a -> f a
unwrapDivisible :: f a }
  deriving ((forall x. WrappedDivisible f a -> Rep (WrappedDivisible f a) x)
-> (forall x. Rep (WrappedDivisible f a) x -> WrappedDivisible f a)
-> Generic (WrappedDivisible f a)
forall x. Rep (WrappedDivisible f a) x -> WrappedDivisible f a
forall x. WrappedDivisible f a -> Rep (WrappedDivisible f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) (a :: k) x.
Rep (WrappedDivisible f a) x -> WrappedDivisible f a
forall k (f :: k -> *) (a :: k) x.
WrappedDivisible f a -> Rep (WrappedDivisible f a) x
$cfrom :: forall k (f :: k -> *) (a :: k) x.
WrappedDivisible f a -> Rep (WrappedDivisible f a) x
from :: forall x. WrappedDivisible f a -> Rep (WrappedDivisible f a) x
$cto :: forall k (f :: k -> *) (a :: k) x.
Rep (WrappedDivisible f a) x -> WrappedDivisible f a
to :: forall x. Rep (WrappedDivisible f a) x -> WrappedDivisible f a
Generic, WrappedDivisible f a -> WrappedDivisible f a -> Bool
(WrappedDivisible f a -> WrappedDivisible f a -> Bool)
-> (WrappedDivisible f a -> WrappedDivisible f a -> Bool)
-> Eq (WrappedDivisible f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
== :: WrappedDivisible f a -> WrappedDivisible f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
/= :: WrappedDivisible f a -> WrappedDivisible f a -> Bool
Eq, Int -> WrappedDivisible f a -> ShowS
[WrappedDivisible f a] -> ShowS
WrappedDivisible f a -> String
(Int -> WrappedDivisible f a -> ShowS)
-> (WrappedDivisible f a -> String)
-> ([WrappedDivisible f a] -> ShowS)
-> Show (WrappedDivisible f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> WrappedDivisible f a -> ShowS
forall k (f :: k -> *) (a :: k).
Show (f a) =>
[WrappedDivisible f a] -> ShowS
forall k (f :: k -> *) (a :: k).
Show (f a) =>
WrappedDivisible f a -> String
$cshowsPrec :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> WrappedDivisible f a -> ShowS
showsPrec :: Int -> WrappedDivisible f a -> ShowS
$cshow :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
WrappedDivisible f a -> String
show :: WrappedDivisible f a -> String
$cshowList :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
[WrappedDivisible f a] -> ShowS
showList :: [WrappedDivisible f a] -> ShowS
Show, Eq (WrappedDivisible f a)
Eq (WrappedDivisible f a) =>
(WrappedDivisible f a -> WrappedDivisible f a -> Ordering)
-> (WrappedDivisible f a -> WrappedDivisible f a -> Bool)
-> (WrappedDivisible f a -> WrappedDivisible f a -> Bool)
-> (WrappedDivisible f a -> WrappedDivisible f a -> Bool)
-> (WrappedDivisible f a -> WrappedDivisible f a -> Bool)
-> (WrappedDivisible f a
    -> WrappedDivisible f a -> WrappedDivisible f a)
-> (WrappedDivisible f a
    -> WrappedDivisible f a -> WrappedDivisible f a)
-> Ord (WrappedDivisible f a)
WrappedDivisible f a -> WrappedDivisible f a -> Bool
WrappedDivisible f a -> WrappedDivisible f a -> Ordering
WrappedDivisible f a
-> WrappedDivisible f a -> WrappedDivisible f a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Eq (WrappedDivisible f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a
-> WrappedDivisible f a -> WrappedDivisible f a
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Ordering
compare :: WrappedDivisible f a -> WrappedDivisible f a -> Ordering
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
< :: WrappedDivisible f a -> WrappedDivisible f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
<= :: WrappedDivisible f a -> WrappedDivisible f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
> :: WrappedDivisible f a -> WrappedDivisible f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a -> WrappedDivisible f a -> Bool
>= :: WrappedDivisible f a -> WrappedDivisible f a -> Bool
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a
-> WrappedDivisible f a -> WrappedDivisible f a
max :: WrappedDivisible f a
-> WrappedDivisible f a -> WrappedDivisible f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
WrappedDivisible f a
-> WrappedDivisible f a -> WrappedDivisible f a
min :: WrappedDivisible f a
-> WrappedDivisible f a -> WrappedDivisible f a
Ord, ReadPrec [WrappedDivisible f a]
ReadPrec (WrappedDivisible f a)
Int -> ReadS (WrappedDivisible f a)
ReadS [WrappedDivisible f a]
(Int -> ReadS (WrappedDivisible f a))
-> ReadS [WrappedDivisible f a]
-> ReadPrec (WrappedDivisible f a)
-> ReadPrec [WrappedDivisible f a]
-> Read (WrappedDivisible f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec [WrappedDivisible f a]
forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec (WrappedDivisible f a)
forall k (f :: k -> *) (a :: k).
Read (f a) =>
Int -> ReadS (WrappedDivisible f a)
forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadS [WrappedDivisible f a]
$creadsPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
Int -> ReadS (WrappedDivisible f a)
readsPrec :: Int -> ReadS (WrappedDivisible f a)
$creadList :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadS [WrappedDivisible f a]
readList :: ReadS [WrappedDivisible f a]
$creadPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec (WrappedDivisible f a)
readPrec :: ReadPrec (WrappedDivisible f a)
$creadListPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec [WrappedDivisible f a]
readListPrec :: ReadPrec [WrappedDivisible f a]
Read, (forall a b.
 (a -> b) -> WrappedDivisible f a -> WrappedDivisible f b)
-> (forall a b. a -> WrappedDivisible f b -> WrappedDivisible f a)
-> Functor (WrappedDivisible f)
forall a b. a -> WrappedDivisible f b -> WrappedDivisible f a
forall a b.
(a -> b) -> WrappedDivisible f a -> WrappedDivisible f b
forall (f :: * -> *) a b.
Functor f =>
a -> WrappedDivisible f b -> WrappedDivisible f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WrappedDivisible f a -> WrappedDivisible f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WrappedDivisible f a -> WrappedDivisible f b
fmap :: forall a b.
(a -> b) -> WrappedDivisible f a -> WrappedDivisible f b
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> WrappedDivisible f b -> WrappedDivisible f a
<$ :: forall a b. a -> WrappedDivisible f b -> WrappedDivisible f a
Functor, (forall m. Monoid m => WrappedDivisible f m -> m)
-> (forall m a. Monoid m => (a -> m) -> WrappedDivisible f a -> m)
-> (forall m a. Monoid m => (a -> m) -> WrappedDivisible f a -> m)
-> (forall a b. (a -> b -> b) -> b -> WrappedDivisible f a -> b)
-> (forall a b. (a -> b -> b) -> b -> WrappedDivisible f a -> b)
-> (forall b a. (b -> a -> b) -> b -> WrappedDivisible f a -> b)
-> (forall b a. (b -> a -> b) -> b -> WrappedDivisible f a -> b)
-> (forall a. (a -> a -> a) -> WrappedDivisible f a -> a)
-> (forall a. (a -> a -> a) -> WrappedDivisible f a -> a)
-> (forall a. WrappedDivisible f a -> [a])
-> (forall a. WrappedDivisible f a -> Bool)
-> (forall a. WrappedDivisible f a -> Int)
-> (forall a. Eq a => a -> WrappedDivisible f a -> Bool)
-> (forall a. Ord a => WrappedDivisible f a -> a)
-> (forall a. Ord a => WrappedDivisible f a -> a)
-> (forall a. Num a => WrappedDivisible f a -> a)
-> (forall a. Num a => WrappedDivisible f a -> a)
-> Foldable (WrappedDivisible f)
forall a. Eq a => a -> WrappedDivisible f a -> Bool
forall a. Num a => WrappedDivisible f a -> a
forall a. Ord a => WrappedDivisible f a -> a
forall m. Monoid m => WrappedDivisible f m -> m
forall a. WrappedDivisible f a -> Bool
forall a. WrappedDivisible f a -> Int
forall a. WrappedDivisible f a -> [a]
forall a. (a -> a -> a) -> WrappedDivisible f a -> a
forall m a. Monoid m => (a -> m) -> WrappedDivisible f a -> m
forall b a. (b -> a -> b) -> b -> WrappedDivisible f a -> b
forall a b. (a -> b -> b) -> b -> WrappedDivisible f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> WrappedDivisible f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
WrappedDivisible f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WrappedDivisible f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
WrappedDivisible f m -> m
forall (f :: * -> *) a. Foldable f => WrappedDivisible f a -> Bool
forall (f :: * -> *) a. Foldable f => WrappedDivisible f a -> Int
forall (f :: * -> *) a. Foldable f => WrappedDivisible f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WrappedDivisible f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WrappedDivisible f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WrappedDivisible f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WrappedDivisible f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
WrappedDivisible f m -> m
fold :: forall m. Monoid m => WrappedDivisible f m -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WrappedDivisible f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WrappedDivisible f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WrappedDivisible f a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WrappedDivisible f a -> m
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WrappedDivisible f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WrappedDivisible f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WrappedDivisible f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WrappedDivisible f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WrappedDivisible f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WrappedDivisible f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WrappedDivisible f a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WrappedDivisible f a -> b
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WrappedDivisible f a -> a
foldr1 :: forall a. (a -> a -> a) -> WrappedDivisible f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WrappedDivisible f a -> a
foldl1 :: forall a. (a -> a -> a) -> WrappedDivisible f a -> a
$ctoList :: forall (f :: * -> *) a. Foldable f => WrappedDivisible f a -> [a]
toList :: forall a. WrappedDivisible f a -> [a]
$cnull :: forall (f :: * -> *) a. Foldable f => WrappedDivisible f a -> Bool
null :: forall a. WrappedDivisible f a -> Bool
$clength :: forall (f :: * -> *) a. Foldable f => WrappedDivisible f a -> Int
length :: forall a. WrappedDivisible f a -> Int
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> WrappedDivisible f a -> Bool
elem :: forall a. Eq a => a -> WrappedDivisible f a -> Bool
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WrappedDivisible f a -> a
maximum :: forall a. Ord a => WrappedDivisible f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WrappedDivisible f a -> a
minimum :: forall a. Ord a => WrappedDivisible f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
WrappedDivisible f a -> a
sum :: forall a. Num a => WrappedDivisible f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
WrappedDivisible f a -> a
product :: forall a. Num a => WrappedDivisible f a -> a
Foldable, Functor (WrappedDivisible f)
Foldable (WrappedDivisible f)
(Functor (WrappedDivisible f), Foldable (WrappedDivisible f)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WrappedDivisible f a -> f (WrappedDivisible f b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WrappedDivisible f (f a) -> f (WrappedDivisible f a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WrappedDivisible f a -> m (WrappedDivisible f b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WrappedDivisible f (m a) -> m (WrappedDivisible f a))
-> Traversable (WrappedDivisible f)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *). Traversable f => Functor (WrappedDivisible f)
forall (f :: * -> *).
Traversable f =>
Foldable (WrappedDivisible f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
WrappedDivisible f (m a) -> m (WrappedDivisible f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
WrappedDivisible f (f a) -> f (WrappedDivisible f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> WrappedDivisible f a -> m (WrappedDivisible f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> WrappedDivisible f a -> f (WrappedDivisible f b)
forall (m :: * -> *) a.
Monad m =>
WrappedDivisible f (m a) -> m (WrappedDivisible f a)
forall (f :: * -> *) a.
Applicative f =>
WrappedDivisible f (f a) -> f (WrappedDivisible f a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WrappedDivisible f a -> m (WrappedDivisible f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WrappedDivisible f a -> f (WrappedDivisible f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> WrappedDivisible f a -> f (WrappedDivisible f b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WrappedDivisible f a -> f (WrappedDivisible f b)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
WrappedDivisible f (f a) -> f (WrappedDivisible f a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WrappedDivisible f (f a) -> f (WrappedDivisible f a)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> WrappedDivisible f a -> m (WrappedDivisible f b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WrappedDivisible f a -> m (WrappedDivisible f b)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
WrappedDivisible f (m a) -> m (WrappedDivisible f a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WrappedDivisible f (m a) -> m (WrappedDivisible f a)
Traversable)
  deriving newtype (Contravariant (WrappedDivisible f)
Contravariant (WrappedDivisible f) =>
(forall a b c.
 (a -> (b, c))
 -> WrappedDivisible f b
 -> WrappedDivisible f c
 -> WrappedDivisible f a)
-> (forall a. WrappedDivisible f a)
-> Divisible (WrappedDivisible f)
forall a. WrappedDivisible f a
forall a b c.
(a -> (b, c))
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
forall (f :: * -> *).
Contravariant f =>
(forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a) -> Divisible f
forall (f :: * -> *).
Divisible f =>
Contravariant (WrappedDivisible f)
forall (f :: * -> *) a. Divisible f => WrappedDivisible f a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c))
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
$cdivide :: forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c))
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
divide :: forall a b c.
(a -> (b, c))
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
$cconquer :: forall (f :: * -> *) a. Divisible f => WrappedDivisible f a
conquer :: forall a. WrappedDivisible f a
Divisible, (forall a' a.
 (a' -> a) -> WrappedDivisible f a -> WrappedDivisible f a')
-> (forall b a. b -> WrappedDivisible f b -> WrappedDivisible f a)
-> Contravariant (WrappedDivisible f)
forall b a. b -> WrappedDivisible f b -> WrappedDivisible f a
forall a' a.
(a' -> a) -> WrappedDivisible f a -> WrappedDivisible f a'
forall (f :: * -> *) b a.
Contravariant f =>
b -> WrappedDivisible f b -> WrappedDivisible f a
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> WrappedDivisible f a -> WrappedDivisible f a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> WrappedDivisible f a -> WrappedDivisible f a'
contramap :: forall a' a.
(a' -> a) -> WrappedDivisible f a -> WrappedDivisible f a'
$c>$ :: forall (f :: * -> *) b a.
Contravariant f =>
b -> WrappedDivisible f b -> WrappedDivisible f a
>$ :: forall b a. b -> WrappedDivisible f b -> WrappedDivisible f a
Contravariant)

deriveShow1 ''WrappedDivisible
deriveRead1 ''WrappedDivisible
deriveEq1 ''WrappedDivisible
deriveOrd1 ''WrappedDivisible

instance Contravariant f => Invariant (WrappedDivisible f) where
  invmap :: forall a b.
(a -> b)
-> (b -> a) -> WrappedDivisible f a -> WrappedDivisible f b
invmap a -> b
_ b -> a
g (WrapDivisible f a
x) = f b -> WrappedDivisible f b
forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisible f a
WrapDivisible ((b -> a) -> f a -> f b
forall a' a. (a' -> a) -> f a -> f a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap b -> a
g f a
x)

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 {k} (f :: k -> *) (a :: k). 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)

#if MIN_VERSION_base(4,9,0)
-- | Unlike 'Divisible', requires only 'Semigroup' on @r@.
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@.
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@.
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)
#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 :: forall a b c.
(a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
divise = (a -> (b, c)) -> Comparison b -> Comparison c -> Comparison a
forall a b c.
(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 :: forall a b c.
(a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
divise = (a -> (b, c)) -> Equivalence b -> Equivalence c -> Equivalence a
forall a b c.
(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 :: forall a b c.
(a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
divise = (a -> (b, c)) -> Predicate b -> Predicate c -> Predicate a
forall a b c.
(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 :: forall a b c. (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
divise = (a -> (b, c)) -> Proxy b -> Proxy c -> Proxy a
forall a b c. (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 :: forall a b c.
(a -> (b, c))
-> SettableStateVar b -> SettableStateVar c -> SettableStateVar a
divise = (a -> (b, c))
-> SettableStateVar b -> SettableStateVar c -> SettableStateVar a
forall a b c.
(a -> (b, c))
-> SettableStateVar b -> SettableStateVar c -> SettableStateVar a
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide
#endif

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

#ifdef GHC_GENERICS
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 c -> U1 a
forall a b c. (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
instance Divise V1 where divise :: forall a b c. (a -> (b, c)) -> V1 b -> V1 c -> V1 a
divise a -> (b, c)
_ = \case {}

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

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

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@.
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)
#endif

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

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

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

#if !MIN_VERSION_transformers(0,6,0)
instance Divise m => Divise (ErrorT e m) where
  divise f (ErrorT l) (ErrorT r) = ErrorT $ divise (funzip . fmap f) l r

instance Divise m => Divise (ListT m) where
  divise f (ListT l) (ListT r) = ListT $ divise (funzip . map f) l r
#endif

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

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)

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)

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)

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)

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)

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

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

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)

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

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

-- TODO: WrappedContravariant