{-# LANGUAGE CPP, DerivingVia, StandaloneDeriving, TypeOperators #-}
module Control.Subcategory.Zip
  ( CZip(..),
    CUnzip(..),
    cunzipDefault,
    CZippy(..),
    CRepeat(..),
    module Control.Subcategory.Semialign
  ) where
import           Control.Applicative                  (ZipList (..))
import           Control.Arrow                        (Arrow ((&&&)), (***))
import           Control.Monad.Zip                    (MonadZip (mzip),
                                                       mzipWith)
import           Control.Subcategory.Functor
import           Control.Subcategory.Semialign
import           Control.Subcategory.Wrapper.Internal
import           Data.Coerce                          (coerce)
import           Data.Containers
import           Data.Functor.Compose                 (Compose (..))
import           Data.Functor.Identity
import qualified Data.Functor.Product                 as SOP
import           Data.Hashable                        (Hashable)
import qualified Data.HashMap.Strict                  as HM
import qualified Data.IntMap.Strict                   as IM
import qualified Data.List.NonEmpty                   as NE
import qualified Data.Map.Strict                      as M
import           Data.MonoTraversable
import qualified Data.Primitive.Array                 as A
import qualified Data.Primitive.PrimArray             as PA
import qualified Data.Primitive.SmallArray            as SA
import           Data.Proxy
#if !MIN_VERSION_base(4,16,0)
import           Data.Semigroup                       (Option (..))
#endif
import qualified Data.Sequence                        as Seq
import qualified Data.Sequences                       as MT
import           Data.Tree
import qualified Data.Vector                          as V
import qualified Data.Vector.Generic                  as G
import qualified Data.Vector.Primitive                as Prim
import qualified Data.Vector.Primitive                as PV
import qualified Data.Vector.Storable                 as S
import qualified Data.Vector.Unboxed                  as U
import           Data.Zip
import           GHC.Generics                         ((:*:) (..), (:.:) (..))
import           Prelude                              hiding (repeat, unzip,
                                                       zip, zipWith)
import qualified Prelude                              as P

class CSemialign f => CZip f where
  czipWith
    :: (Dom f a, Dom f b, Dom f c)
    => (a -> b -> c) -> f a -> f b -> f c
  czip
    :: (Dom f a, Dom f b, Dom f (a, b))
    => f a -> f b -> f (a, b)
  {-# INLINE [1] czip #-}
  czip = forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith (,)

instance Zip f => CZip (WrapFunctor f) where
  czip :: forall a b.
(Dom (WrapFunctor f) a, Dom (WrapFunctor f) b,
 Dom (WrapFunctor f) (a, b)) =>
WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f (a, b)
czip = forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip
  {-# INLINE [1] czip #-}
  czipWith :: forall a b c.
(Dom (WrapFunctor f) a, Dom (WrapFunctor f) b,
 Dom (WrapFunctor f) c) =>
(a -> b -> c)
-> WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f c
czipWith = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
  {-# INLINE [1] czipWith #-}

deriving via WrapFunctor [] instance CZip []
deriving via WrapFunctor Maybe instance CZip Maybe
#if !MIN_VERSION_base(4,16,0)
deriving newtype instance CZip Option
#endif
deriving via WrapFunctor ZipList instance CZip ZipList
deriving via WrapFunctor Identity instance CZip Identity
deriving via WrapFunctor NE.NonEmpty instance CZip NE.NonEmpty
deriving via WrapFunctor Tree instance CZip Tree
deriving via WrapFunctor ((->) e) instance CZip ((->) e)

#if MIN_VERSION_semialign(1,1,0)
deriving via WrapFunctor Seq.Seq instance CZip Seq.Seq
deriving via WrapFunctor (M.Map k) instance Ord k => CZip (M.Map k)
deriving via WrapFunctor (HM.HashMap k)
  instance (Eq k, Hashable k)
  => CZip (HM.HashMap k)
deriving via WrapFunctor IM.IntMap instance CZip IM.IntMap
#else
instance CZip Seq.Seq where
  czipWith = Seq.zipWith
  {-# INLINE [1] czipWith #-}
  czip = Seq.zip
  {-# INLINE [1] czip #-}
instance Ord k => CZip (M.Map k) where
  czipWith = M.intersectionWith
  {-# INLINE [1] czipWith #-}
instance (Eq k, Hashable k) => CZip (HM.HashMap k) where
  czipWith = HM.intersectionWith
  {-# INLINE [1] czipWith #-}
instance CZip IM.IntMap where
  czipWith = IM.intersectionWith
  {-# INLINE [1] czipWith #-}
#endif


instance CZip V.Vector where
  czip :: forall a b.
(Dom Vector a, Dom Vector b, Dom Vector (a, b)) =>
Vector a -> Vector b -> Vector (a, b)
czip = forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip
  {-# INLINE [1] czip #-}
  czipWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
czipWith = forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
  {-# INLINE [1] czipWith #-}

instance CZip U.Vector where
  czip :: forall a b.
(Dom Vector a, Dom Vector b, Dom Vector (a, b)) =>
Vector a -> Vector b -> Vector (a, b)
czip = forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
U.zip
  {-# INLINE [1] czip #-}
  czipWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
czipWith = forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
U.zipWith
  {-# INLINE [1] czipWith #-}

instance CZip S.Vector where
  czipWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
czipWith = forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
S.zipWith
  {-# INLINE [1] czipWith #-}

instance CZip Prim.Vector where
  czipWith :: forall a b c.
(Dom Vector a, Dom Vector b, Dom Vector c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
czipWith = forall a b c.
(Prim a, Prim b, Prim c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
Prim.zipWith
  {-# INLINE [1] czipWith #-}

instance CZip Proxy where
  czip :: forall a b.
(Dom Proxy a, Dom Proxy b, Dom Proxy (a, b)) =>
Proxy a -> Proxy b -> Proxy (a, b)
czip = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall {k} (t :: k). Proxy t
Proxy
  {-# INLINE czip #-}
  czipWith :: forall a b c.
(Dom Proxy a, Dom Proxy b, Dom Proxy c) =>
(a -> b -> c) -> Proxy a -> Proxy b -> Proxy c
czipWith = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall {k} (t :: k). Proxy t
Proxy
  {-# INLINE czipWith #-}

instance (CZip f, CZip g) => CZip (SOP.Product f g) where
  czipWith :: forall a b c.
(Dom (Product f g) a, Dom (Product f g) b, Dom (Product f g) c) =>
(a -> b -> c) -> Product f g a -> Product f g b -> Product f g c
czipWith a -> b -> c
f (SOP.Pair f a
a g a
b) (SOP.Pair f b
c g b
d) =
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith a -> b -> c
f f a
a f b
c) (forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith a -> b -> c
f g a
b g b
d)
  {-# INLINE [1] czipWith #-}
  czip :: forall a b.
(Dom (Product f g) a, Dom (Product f g) b,
 Dom (Product f g) (a, b)) =>
Product f g a -> Product f g b -> Product f g (a, b)
czip (SOP.Pair f a
a g a
b) (SOP.Pair f b
c g b
d) =
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (forall (f :: * -> *) a b.
(CZip f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
czip f a
a f b
c) (forall (f :: * -> *) a b.
(CZip f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
czip g a
b g b
d)
  {-# INLINE [1] czip #-}

instance (CZip f, CZip g) => CZip (f :*: g) where
  czipWith :: forall a b c.
(Dom (f :*: g) a, Dom (f :*: g) b, Dom (f :*: g) c) =>
(a -> b -> c) -> (:*:) f g a -> (:*:) f g b -> (:*:) f g c
czipWith a -> b -> c
f (f a
a :*: g a
b) (f b
c :*: g b
d) =
    forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith a -> b -> c
f f a
a f b
c forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith a -> b -> c
f g a
b g b
d
  {-# INLINE [1] czipWith #-}
  czip :: forall a b.
(Dom (f :*: g) a, Dom (f :*: g) b, Dom (f :*: g) (a, b)) =>
(:*:) f g a -> (:*:) f g b -> (:*:) f g (a, b)
czip (f a
a :*: g a
b) (f b
c :*: g b
d) =
    forall (f :: * -> *) a b.
(CZip f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
czip f a
a f b
c forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a b.
(CZip f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
czip g a
b g b
d
  {-# INLINE [1] czip #-}

instance (CZip f, CZip g) => CZip (Compose f g) where
  czipWith :: forall a b c.
(Dom (Compose f g) a, Dom (Compose f g) b, Dom (Compose f g) c) =>
(a -> b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
czipWith a -> b -> c
f (Compose f (g a)
a) (Compose f (g b)
b) =
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith (forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith a -> b -> c
f) f (g a)
a f (g b)
b
  {-# INLINE [1] czipWith #-}
  czip :: forall a b.
(Dom (Compose f g) a, Dom (Compose f g) b,
 Dom (Compose f g) (a, b)) =>
Compose f g a -> Compose f g b -> Compose f g (a, b)
czip (Compose f (g a)
a) (Compose f (g b)
b) =
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith forall (f :: * -> *) a b.
(CZip f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
czip f (g a)
a f (g b)
b
  {-# INLINE [1] czip #-}

instance (CZip f, CZip g) => CZip (f :.: g) where
  czipWith :: forall a b c.
(Dom (f :.: g) a, Dom (f :.: g) b, Dom (f :.: g) c) =>
(a -> b -> c) -> (:.:) f g a -> (:.:) f g b -> (:.:) f g c
czipWith a -> b -> c
f (Comp1 f (g a)
a) (Comp1 f (g b)
b) =
    forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith (forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith a -> b -> c
f) f (g a)
a f (g b)
b
  {-# INLINE [1] czipWith #-}
  czip :: forall a b.
(Dom (f :.: g) a, Dom (f :.: g) b, Dom (f :.: g) (a, b)) =>
(:.:) f g a -> (:.:) f g b -> (:.:) f g (a, b)
czip (Comp1 f (g a)
a) (Comp1 f (g b)
b) =
    forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith forall (f :: * -> *) a b.
(CZip f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
czip f (g a)
a f (g b)
b
  {-# INLINE [1] czip #-}

{-# RULES
"czip/List"
  czip = P.zip
"czipWith/List"
  czipWith = P.zipWith
"czip/NonEmpty"
  czip = NE.zip
"czipWith/NonEmpty"
  czipWith = NE.zipWith
"czip/Seq"
  czip = Seq.zip
"czipWith/Seq"
  czipWith = Seq.zipWith
  #-}

class CZip f => CRepeat f where
  crepeat :: Dom f a => a -> f a

newtype CZippy f a = CZippy { forall {k} (f :: k -> *) (a :: k). CZippy f a -> f a
runCZippy :: f a }
  deriving (Int -> CZippy f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> CZippy f a -> ShowS
forall k (f :: k -> *) (a :: k).
Show (f a) =>
[CZippy f a] -> ShowS
forall k (f :: k -> *) (a :: k). Show (f a) => CZippy f a -> String
showList :: [CZippy f a] -> ShowS
$cshowList :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
[CZippy f a] -> ShowS
show :: CZippy f a -> String
$cshow :: forall k (f :: k -> *) (a :: k). Show (f a) => CZippy f a -> String
showsPrec :: Int -> CZippy f a -> ShowS
$cshowsPrec :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> CZippy f a -> ShowS
Show, ReadPrec [CZippy f a]
ReadPrec (CZippy f a)
ReadS [CZippy 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 [CZippy f a]
forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec (CZippy f a)
forall k (f :: k -> *) (a :: k).
Read (f a) =>
Int -> ReadS (CZippy f a)
forall k (f :: k -> *) (a :: k). Read (f a) => ReadS [CZippy f a]
readListPrec :: ReadPrec [CZippy f a]
$creadListPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec [CZippy f a]
readPrec :: ReadPrec (CZippy f a)
$creadPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
ReadPrec (CZippy f a)
readList :: ReadS [CZippy f a]
$creadList :: forall k (f :: k -> *) (a :: k). Read (f a) => ReadS [CZippy f a]
readsPrec :: Int -> ReadS (CZippy f a)
$creadsPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
Int -> ReadS (CZippy f a)
Read)
  deriving newtype (forall a b. a -> CZippy f b -> CZippy f a
forall a b. (a -> b) -> CZippy f a -> CZippy f b
forall (f :: * -> *) a b.
Functor f =>
a -> CZippy f b -> CZippy f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> CZippy f a -> CZippy 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 -> CZippy f b -> CZippy f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> CZippy f b -> CZippy f a
fmap :: forall a b. (a -> b) -> CZippy f a -> CZippy f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> CZippy f a -> CZippy f b
Functor, forall a b. CZippy f a -> CZippy f b -> CZippy f (a, b)
forall a b c.
(a -> b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
forall (f :: * -> *).
Semialign f
-> (forall a b. f a -> f b -> f (a, b))
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Zip f
forall {f :: * -> *}. Zip f => Semialign (CZippy f)
forall (f :: * -> *) a b.
Zip f =>
CZippy f a -> CZippy f b -> CZippy f (a, b)
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
zipWith :: forall a b c.
(a -> b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
$czipWith :: forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
zip :: forall a b. CZippy f a -> CZippy f b -> CZippy f (a, b)
$czip :: forall (f :: * -> *) a b.
Zip f =>
CZippy f a -> CZippy f b -> CZippy f (a, b)
Zip, forall a b. CZippy f a -> CZippy f b -> CZippy f (These a b)
forall a b c.
(These a b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
forall (f :: * -> *).
Functor f
-> (forall a b. f a -> f b -> f (These a b))
-> (forall a b c. (These a b -> c) -> f a -> f b -> f c)
-> Semialign f
forall {f :: * -> *}. Semialign f => Functor (CZippy f)
forall (f :: * -> *) a b.
Semialign f =>
CZippy f a -> CZippy f b -> CZippy f (These a b)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
alignWith :: forall a b c.
(These a b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
$calignWith :: forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
align :: forall a b. CZippy f a -> CZippy f b -> CZippy f (These a b)
$calign :: forall (f :: * -> *) a b.
Semialign f =>
CZippy f a -> CZippy f b -> CZippy f (These a b)
Semialign, CZippy f a -> CZippy f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
CZippy f a -> CZippy f a -> Bool
/= :: CZippy f a -> CZippy f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
CZippy f a -> CZippy f a -> Bool
== :: CZippy f a -> CZippy f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
CZippy f a -> CZippy f a -> Bool
Eq, CZippy f a -> CZippy f a -> Bool
CZippy f a -> CZippy f a -> Ordering
CZippy f a -> CZippy f a -> CZippy 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 (CZippy f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> CZippy f a
min :: CZippy f a -> CZippy f a -> CZippy f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> CZippy f a
max :: CZippy f a -> CZippy f a -> CZippy f a
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> CZippy f a
>= :: CZippy f a -> CZippy f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Bool
> :: CZippy f a -> CZippy f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Bool
<= :: CZippy f a -> CZippy f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Bool
< :: CZippy f a -> CZippy f a -> Bool
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Bool
compare :: CZippy f a -> CZippy f a -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CZippy f a -> CZippy f a -> Ordering
Ord)
  deriving newtype (forall (f :: * -> *). Constrained f
Constrained)
#if MIN_VERSION_semialign(1,1,0)
  deriving newtype (forall a. a -> CZippy f a
forall (f :: * -> *). Zip f -> (forall a. a -> f a) -> Repeat f
forall {f :: * -> *}. Repeat f => Zip (CZippy f)
forall (f :: * -> *) a. Repeat f => a -> CZippy f a
repeat :: forall a. a -> CZippy f a
$crepeat :: forall (f :: * -> *) a. Repeat f => a -> CZippy f a
Repeat)
#endif

instance CFunctor f => CFunctor (CZippy f) where
  cmap :: forall a b.
(Dom (CZippy f) a, Dom (CZippy f) b) =>
(a -> b) -> CZippy f a -> CZippy f b
cmap = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap @f @a @b
    :: forall a b. (Dom f a, Dom f b) => (a -> b) -> CZippy f a -> CZippy f b
  {-# INLINE [1] cmap #-}

instance CSemialign f => CSemialign (CZippy f) where
  calignWith :: forall a b c.
(Dom (CZippy f) a, Dom (CZippy f) b, Dom (CZippy f) c) =>
(These a b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
calignWith = \These a b -> c
f -> coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CSemialign f, Dom f a, Dom f b, Dom f c) =>
(These a b -> c) -> f a -> f b -> f c
calignWith @f These a b -> c
f
  {-# INLINE [1] calignWith #-}

instance CZip f => CZip (CZippy f) where
  czipWith :: forall a b c.
(Dom (CZippy f) a, Dom (CZippy f) b, Dom (CZippy f) c) =>
(a -> b -> c) -> CZippy f a -> CZippy f b -> CZippy f c
czipWith a -> b -> c
f = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith @f a -> b -> c
f
  {-# INLINE [1] czipWith #-}

instance CRepeat f => CRepeat (CZippy f) where
  crepeat :: forall a. Dom (CZippy f) a => a -> CZippy f a
crepeat = forall {k} (f :: k -> *) (a :: k). f a -> CZippy f a
CZippy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (CRepeat f, Dom f a) => a -> f a
crepeat
  {-# INLINE [1] crepeat #-}

instance (CZip f, Dom f a, Semigroup a) => Semigroup (CZippy f a) where
  <> :: CZippy f a -> CZippy f a -> CZippy f a
(<>) = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
(CZip f, Dom f a, Dom f b, Dom f c) =>
(a -> b -> c) -> f a -> f b -> f c
czipWith @f (forall a. Semigroup a => a -> a -> a
(<>) @a)
  {-# INLINE [1] (<>) #-}

instance (CRepeat f, Dom f a, Monoid a) => Monoid (CZippy f a) where
  mempty :: CZippy f a
mempty = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (CRepeat f, Dom f a) => a -> f a
crepeat @f (forall a. Monoid a => a
mempty @a)
  {-# INLINE [1] mempty #-}

#if MIN_VERSION_semialign(1,1,0)
instance Repeat f => CRepeat (WrapFunctor f) where
  crepeat :: forall a. Dom (WrapFunctor f) a => a -> WrapFunctor f a
crepeat = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Repeat f => a -> f a
repeat @f @a
    :: forall a. a -> WrapFunctor f a
  {-# INLINE [1] crepeat #-}
deriving via WrapFunctor [] instance CRepeat []
deriving via WrapFunctor Maybe instance CRepeat Maybe
#if !MIN_VERSION_base(4,16,0)
deriving newtype instance CRepeat Option
#endif
deriving via WrapFunctor ZipList instance CRepeat ZipList
deriving via WrapFunctor Identity instance CRepeat Identity
deriving via WrapFunctor NE.NonEmpty instance CRepeat NE.NonEmpty
deriving via WrapFunctor Tree instance CRepeat Tree
deriving via WrapFunctor ((->) e) instance CRepeat ((->) e)
#else
instance CRepeat [] where
  crepeat = P.repeat
  {-# INLINE [1] crepeat #-}
instance CRepeat Maybe where
  crepeat = Just
  {-# INLINE [1] crepeat #-}
deriving newtype instance CRepeat Option
deriving newtype instance CRepeat ZipList
instance CRepeat Identity where
  crepeat = Identity
  {-# INLINE [1] crepeat #-}
instance CRepeat NE.NonEmpty where
  crepeat = NE.repeat
  {-# INLINE [1] crepeat #-}
instance CRepeat Tree where
  crepeat x = n where n = Node x (P.repeat n)
  {-# INLINE [1] crepeat #-}
instance CRepeat Proxy where
  crepeat = const Proxy
  {-# INLINE [1] crepeat #-}
instance CRepeat ((->) e) where
  crepeat = const
  {-# INLINE [1] crepeat #-}
#endif

instance CZip SA.SmallArray where
  czip :: forall a b.
(Dom SmallArray a, Dom SmallArray b, Dom SmallArray (a, b)) =>
SmallArray a -> SmallArray b -> SmallArray (a, b)
czip = forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip
  {-# INLINE [1] czip #-}
  czipWith :: forall a b c.
(Dom SmallArray a, Dom SmallArray b, Dom SmallArray c) =>
(a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
czipWith = forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith
  {-# INLINE [1] czipWith #-}

instance CZip A.Array where
  czip :: forall a b.
(Dom Array a, Dom Array b, Dom Array (a, b)) =>
Array a -> Array b -> Array (a, b)
czip = forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip
  {-# INLINE [1] czip #-}
  czipWith :: forall a b c.
(Dom Array a, Dom Array b, Dom Array c) =>
(a -> b -> c) -> Array a -> Array b -> Array c
czipWith = forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith
  {-# INLINE [1] czipWith #-}

instance CZip PA.PrimArray where
  czipWith :: forall a b c.
(Dom PrimArray a, Dom PrimArray b, Dom PrimArray c) =>
(a -> b -> c) -> PrimArray a -> PrimArray b -> PrimArray c
czipWith a -> b -> c
f PrimArray a
l PrimArray b
r =
    forall a. Prim a => Int -> (Int -> a) -> PrimArray a
PA.generatePrimArray
      (forall a. Prim a => PrimArray a -> Int
PA.sizeofPrimArray PrimArray a
l forall a. Ord a => a -> a -> a
`min` forall a. Prim a => PrimArray a -> Int
PA.sizeofPrimArray PrimArray b
r) forall a b. (a -> b) -> a -> b
$ \Int
n ->
        a -> b -> c
f (forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray a
l Int
n) (forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray b
r Int
n)
  {-# INLINE [1] czipWith #-}

class CZip f => CUnzip f where
  cunzip
    :: (Dom f (a, b), Dom f a, Dom f b)
    => f (a, b) -> (f a, f b)
  {-# INLINE [1] cunzip #-}
  cunzip = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith forall a. a -> a
id

  cunzipWith
    :: (Dom f c, Dom f a, Dom f b)
    => (c -> (a, b)) -> f c -> (f a, f b)

cunzipDefault
  :: (CFunctor f, Dom f (a, b), Dom f a, Dom f b)
  => f (a, b) -> (f a, f b)
{-# INLINE cunzipDefault #-}
cunzipDefault :: forall (f :: * -> *) a b.
(CFunctor f, Dom f (a, b), Dom f a, Dom f b) =>
f (a, b) -> (f a, f b)
cunzipDefault = forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap 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.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
cmap forall a b. (a, b) -> b
snd

#if MIN_VERSION_semialign(1,1,0)
instance Unzip f => CUnzip (WrapFunctor f) where
#else
instance (Zip f, Unzip f) => CUnzip (WrapFunctor f) where
#endif
  cunzip :: forall a b. WrapFunctor f (a, b) -> (WrapFunctor f a, WrapFunctor f b)
  {-# INLINE cunzip #-}
  cunzip :: forall a b.
WrapFunctor f (a, b) -> (WrapFunctor f a, WrapFunctor f b)
cunzip = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip @f @a @b
  {-# INLINE cunzipWith #-}
  cunzipWith :: forall c a b.
(Dom (WrapFunctor f) c, Dom (WrapFunctor f) a,
 Dom (WrapFunctor f) b) =>
(c -> (a, b))
-> WrapFunctor f c -> (WrapFunctor f a, WrapFunctor f b)
cunzipWith = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith @f @c @a @b
    :: forall a b c. (c -> (a, b)) -> WrapFunctor f c -> (WrapFunctor f a, WrapFunctor f b)

instance CUnzip [] where
  cunzip :: forall a b.
(Dom [] (a, b), Dom [] a, Dom [] b) =>
[(a, b)] -> ([a], [b])
cunzip = forall a b. [(a, b)] -> ([a], [b])
P.unzip
  {-# INLINE [1] cunzip #-}
  cunzipWith :: forall c a b.
(Dom [] c, Dom [] a, Dom [] b) =>
(c -> (a, b)) -> [c] -> ([a], [b])
cunzipWith = \c -> (a, b)
f -> forall a b. [(a, b)] -> ([a], [b])
P.unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map c -> (a, b)
f
  {-# INLINE [1] cunzipWith #-}

deriving via WrapFunctor Maybe instance CUnzip Maybe
#if MIN_VERSION_semialign(1,1,0)
#if !MIN_VERSION_base(4,16,0)
deriving via WrapFunctor Option instance CUnzip Option
#endif
#endif
deriving via [] instance CUnzip ZipList
deriving via WrapFunctor Identity instance CUnzip Identity
deriving via WrapFunctor NE.NonEmpty instance CUnzip NE.NonEmpty
deriving via WrapFunctor Tree instance CUnzip Tree
instance CUnzip V.Vector where
  cunzip :: forall a b.
(Dom Vector (a, b), Dom Vector a, Dom Vector b) =>
Vector (a, b) -> (Vector a, Vector b)
cunzip = forall a b. Vector (a, b) -> (Vector a, Vector b)
V.unzip
  {-# INLINE [1] cunzip #-}
  cunzipWith :: forall c a b.
(Dom Vector c, Dom Vector a, Dom Vector b) =>
(c -> (a, b)) -> Vector c -> (Vector a, Vector b)
cunzipWith = \c -> (a, b)
f -> forall a b. Vector (a, b) -> (Vector a, Vector b)
V.unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map c -> (a, b)
f
  {-# INLINE [1] cunzipWith #-}
instance CUnzip U.Vector where
  cunzip :: forall a b.
(Dom Vector (a, b), Dom Vector a, Dom Vector b) =>
Vector (a, b) -> (Vector a, Vector b)
cunzip = forall a b.
(Unbox a, Unbox b) =>
Vector (a, b) -> (Vector a, Vector b)
U.unzip
  {-# INLINE [1] cunzip #-}
  cunzipWith :: forall c a b.
(Dom Vector c, Dom Vector a, Dom Vector b) =>
(c -> (a, b)) -> Vector c -> (Vector a, Vector b)
cunzipWith = \c -> (a, b)
f -> forall a b.
(Unbox a, Unbox b) =>
Vector (a, b) -> (Vector a, Vector b)
U.unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
U.map c -> (a, b)
f
  {-# INLINE [1] cunzipWith #-}

instance CUnzip PV.Vector where
  cunzip :: forall a b.
(Dom Vector (a, b), Dom Vector a, Dom Vector b) =>
Vector (a, b) -> (Vector a, Vector b)
cunzip = forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
G.unzip
  {-# INLINE [1] cunzip #-}
  cunzipWith :: forall c a b.
(Dom Vector c, Dom Vector a, Dom Vector b) =>
(c -> (a, b)) -> Vector c -> (Vector a, Vector b)
cunzipWith = \c -> (a, b)
f ->
    (forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
G.convert forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
G.convert)  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith @V.Vector c -> (a, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert
  {-# INLINE [1] cunzipWith #-}

instance CUnzip S.Vector where
  cunzip :: forall a b.
(Dom Vector (a, b), Dom Vector a, Dom Vector b) =>
Vector (a, b) -> (Vector a, Vector b)
cunzip = forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
G.unzip
  {-# INLINE [1] cunzip #-}
  cunzipWith :: forall c a b.
(Dom Vector c, Dom Vector a, Dom Vector b) =>
(c -> (a, b)) -> Vector c -> (Vector a, Vector b)
cunzipWith = \c -> (a, b)
f ->
    (forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
G.convert forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
G.convert)  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith @V.Vector c -> (a, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert
  {-# INLINE [1] cunzipWith #-}
deriving via WrapFunctor Proxy instance CUnzip Proxy
#if MIN_VERSION_semialign(1,1,0)
deriving via WrapFunctor Seq.Seq instance CUnzip Seq.Seq
deriving via WrapFunctor (M.Map k) instance Ord k => CUnzip (M.Map k)
deriving via WrapFunctor IM.IntMap instance CUnzip IM.IntMap
deriving via WrapFunctor (HM.HashMap k)
  instance (Eq k, Hashable k) => CUnzip (HM.HashMap k)
#endif

instance (CUnzip f, CUnzip g) => CUnzip (SOP.Product f g) where
  cunzipWith :: forall c a b.
(Dom (Product f g) c, Dom (Product f g) a, Dom (Product f g) b) =>
(c -> (a, b)) -> Product f g c -> (Product f g a, Product f g b)
cunzipWith c -> (a, b)
f (SOP.Pair f c
a g c
b)  =
    (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair f a
al g a
bl, forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair f b
ar g b
br)
    where
      ~(f a
al, f b
ar) = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith c -> (a, b)
f f c
a
      ~(g a
bl, g b
br) = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith c -> (a, b)
f g c
b
  {-# INLINE [1] cunzipWith #-}
  cunzip :: forall a b.
(Dom (Product f g) (a, b), Dom (Product f g) a,
 Dom (Product f g) b) =>
Product f g (a, b) -> (Product f g a, Product f g b)
cunzip (SOP.Pair f (a, b)
a g (a, b)
b)  =
    (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair f a
al g a
bl, forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair f b
ar g b
br)
    where
      ~(f a
al, f b
ar) = forall (f :: * -> *) a b.
(CUnzip f, Dom f (a, b), Dom f a, Dom f b) =>
f (a, b) -> (f a, f b)
cunzip f (a, b)
a
      ~(g a
bl, g b
br) = forall (f :: * -> *) a b.
(CUnzip f, Dom f (a, b), Dom f a, Dom f b) =>
f (a, b) -> (f a, f b)
cunzip g (a, b)
b
  {-# INLINE [1] cunzip #-}

instance (CUnzip f, CUnzip g) => CUnzip (f :*: g) where
  cunzipWith :: forall c a b.
(Dom (f :*: g) c, Dom (f :*: g) a, Dom (f :*: g) b) =>
(c -> (a, b)) -> (:*:) f g c -> ((:*:) f g a, (:*:) f g b)
cunzipWith c -> (a, b)
f (f c
a :*: g c
b)  =
    (f a
al forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
bl, f b
ar forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g b
br)
    where
      ~(f a
al, f b
ar) = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith c -> (a, b)
f f c
a
      ~(g a
bl, g b
br) = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith c -> (a, b)
f g c
b
  {-# INLINE [1] cunzipWith #-}
  cunzip :: forall a b.
(Dom (f :*: g) (a, b), Dom (f :*: g) a, Dom (f :*: g) b) =>
(:*:) f g (a, b) -> ((:*:) f g a, (:*:) f g b)
cunzip (f (a, b)
a :*: g (a, b)
b)  =
    (f a
al forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
bl, f b
ar forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g b
br)
    where
      ~(f a
al, f b
ar) = forall (f :: * -> *) a b.
(CUnzip f, Dom f (a, b), Dom f a, Dom f b) =>
f (a, b) -> (f a, f b)
cunzip f (a, b)
a
      ~(g a
bl, g b
br) = forall (f :: * -> *) a b.
(CUnzip f, Dom f (a, b), Dom f a, Dom f b) =>
f (a, b) -> (f a, f b)
cunzip g (a, b)
b
  {-# INLINE [1] cunzip #-}

instance (CUnzip f, CUnzip g) => CUnzip (Compose f g) where
  cunzipWith :: forall c a b.
(Dom (Compose f g) c, Dom (Compose f g) a, Dom (Compose f g) b) =>
(c -> (a, b)) -> Compose f g c -> (Compose f g a, Compose f g b)
cunzipWith c -> (a, b)
f (Compose f (g c)
a) = (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g a)
y, forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g b)
z) where
    ~(f (g a)
y, f (g b)
z) = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith (forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith c -> (a, b)
f) f (g c)
a
  {-# INLINE [1] cunzipWith #-}

instance (CUnzip f, CUnzip g) => CUnzip (f :.: g) where
  cunzipWith :: forall c a b.
(Dom (f :.: g) c, Dom (f :.: g) a, Dom (f :.: g) b) =>
(c -> (a, b)) -> (:.:) f g c -> ((:.:) f g a, (:.:) f g b)
cunzipWith c -> (a, b)
f (Comp1 f (g c)
a) = (forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 f (g a)
y, forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 f (g b)
z) where
    ~(f (g a)
y, f (g b)
z) = forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith (forall (f :: * -> *) c a b.
(CUnzip f, Dom f c, Dom f a, Dom f b) =>
(c -> (a, b)) -> f c -> (f a, f b)
cunzipWith c -> (a, b)
f) f (g c)
a
  {-# INLINE [1] cunzipWith #-}

instance (MT.IsSequence mono, MonoZip mono)
  => CZip (WrapMono mono) where
    czipWith :: forall a b c.
(Dom (WrapMono mono) a, Dom (WrapMono mono) b,
 Dom (WrapMono mono) c) =>
(a -> b -> c)
-> WrapMono mono a -> WrapMono mono b -> WrapMono mono c
czipWith a -> b -> c
f = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall mono.
MonoZip mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> mono -> mono
ozipWith @mono a -> b -> c
f
    {-# INLINE [1] czipWith #-}

instance (MT.IsSequence mono, MonoZip mono)
  => CUnzip (WrapMono mono) where
    cunzipWith :: forall c a b.
(Dom (WrapMono mono) c, Dom (WrapMono mono) a,
 Dom (WrapMono mono) b) =>
(c -> (a, b))
-> WrapMono mono c -> (WrapMono mono a, WrapMono mono b)
cunzipWith c -> (a, b)
f = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap @mono (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> (a, b)
f) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap @mono (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> (a, b)
f)