{-# 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.Error
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Identity
import           Control.Monad.Trans.List
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

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

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

#ifdef GHC_GENERICS
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
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) = 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

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

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

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

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

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

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

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

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)

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)

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)

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)

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)

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

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

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)

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

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

-- TODO: WrappedContravariant