{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GADTs #-}
module Data.PTraversable
( PTraversable (..),
ptraverse,
fmapDefault,
foldMapDefault,
traverseDefault,
eq1Default,
liftEq',
liftEqDefault,
compare1Default,
liftCompare',
liftCompareDefault,
cardinality1,
enum1,
coenum1,
WrappedPTraversable (..),
Generically1 (..),
ptraverseDay, ptraverseDayWith,
)
where
import Prelude hiding (Enum)
import Control.Applicative
import Data.Bifunctor.Clown
import Data.Bifunctor.Joker
import Data.Coerce
import Data.Functor.Compose (Compose ())
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Functor.Identity
import Data.Functor.Product (Product)
import Data.Functor.Sum (Sum)
import Data.Profunctor
import Data.Profunctor.Cartesian
import Data.Profunctor.Counting
import Data.Profunctor.Unsafe ((#.), (.#))
import Data.Finitary.Enum ( Enum(..), describeEnum )
import GHC.Generics
import GHC.Generics.Orphans()
import Data.Orphans()
import Data.Functor.Day (Day)
import qualified Data.PTraversable.Internal.Day as DayImpl (ptraverseDay)
import Data.Functor.Classes
import Data.Profunctor.FinFn (withFinFn)
class (Ord1 t, Traversable t) => PTraversable t where
{-# MINIMAL ptraverseWith #-}
ptraverseWith ::
(Cartesian p, Cocartesian p) =>
(as -> t a) ->
(t b -> bs) ->
p a b ->
p as bs
ptraverse :: forall t p a b. (PTraversable t, Cartesian p, Cocartesian p) => p a b -> p (t a) (t b)
ptraverse :: forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse = (t a -> t a) -> (t b -> t b) -> p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
ptraverseWith t a -> t a
forall a. a -> a
id t b -> t b
forall a. a -> a
id
{-# INLINEABLE ptraverse #-}
fmapDefault :: (PTraversable t) => (a -> b) -> t a -> t b
fmapDefault :: forall (t :: * -> *) a b. PTraversable t => (a -> b) -> t a -> t b
fmapDefault = (a -> b) -> t a -> t b
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse
{-# INLINEABLE fmapDefault #-}
foldMapDefault :: (PTraversable t, Monoid m) => (a -> m) -> t a -> m
foldMapDefault :: forall (t :: * -> *) m a.
(PTraversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault = Forget m (t a) (t Any) -> t a -> m
forall {k} r a (b :: k). Forget r a b -> a -> r
runForget (Forget m (t a) (t Any) -> t a -> m)
-> ((a -> m) -> Forget m (t a) (t Any)) -> (a -> m) -> t a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forget m a Any -> Forget m (t a) (t Any)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Forget m a Any -> Forget m (t a) (t Any))
-> ((a -> m) -> Forget m a Any)
-> (a -> m)
-> Forget m (t a) (t Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m) -> Forget m a Any
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget
{-# INLINEABLE foldMapDefault #-}
traverseDefault :: (PTraversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
traverseDefault :: forall (t :: * -> *) (f :: * -> *) a b.
(PTraversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverseDefault = Star f (t a) (t b) -> t a -> f (t b)
forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar (Star f (t a) (t b) -> t a -> f (t b))
-> ((a -> f b) -> Star f (t a) (t b))
-> (a -> f b)
-> t a
-> f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Star f a b -> Star f (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Star f a b -> Star f (t a) (t b))
-> ((a -> f b) -> Star f a b) -> (a -> f b) -> Star f (t a) (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> Star f a b
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star
{-# INLINEABLE traverseDefault #-}
enum1 :: (PTraversable t, Alternative f) => f a -> f (t a)
enum1 :: forall (t :: * -> *) (f :: * -> *) a.
(PTraversable t, Alternative f) =>
f a -> f (t a)
enum1 = Joker f (t Any) (t a) -> f (t a)
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker (Joker f (t Any) (t a) -> f (t a))
-> (f a -> Joker f (t Any) (t a)) -> f a -> f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker f Any a -> Joker f (t Any) (t a)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Joker f Any a -> Joker f (t Any) (t a))
-> (f a -> Joker f Any a) -> f a -> Joker f (t Any) (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Joker f Any a
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker
{-# INLINEABLE enum1 #-}
coenum1 :: (PTraversable t, Divisible f, Decidable f) => f b -> f (t b)
coenum1 :: forall (t :: * -> *) (f :: * -> *) b.
(PTraversable t, Divisible f, Decidable f) =>
f b -> f (t b)
coenum1 = Clown f (t b) (t Any) -> f (t b)
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (b :: k2).
Clown f a b -> f a
runClown (Clown f (t b) (t Any) -> f (t b))
-> (f b -> Clown f (t b) (t Any)) -> f b -> f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f b Any -> Clown f (t b) (t Any)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Clown f b Any -> Clown f (t b) (t Any))
-> (f b -> Clown f b Any) -> f b -> Clown f (t b) (t Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Clown f b Any
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown
{-# INLINEABLE coenum1 #-}
liftEq' :: (PTraversable t) => (a -> a -> Bool) -> t a -> t a -> Bool
liftEq' :: forall (t :: * -> *) a.
PTraversable t =>
(a -> a -> Bool) -> t a -> t a -> Bool
liftEq' = Equivalence (t a) -> t a -> t a -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence (Equivalence (t a) -> t a -> t a -> Bool)
-> ((a -> a -> Bool) -> Equivalence (t a))
-> (a -> a -> Bool)
-> t a
-> t a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Equivalence a -> Equivalence (t a)
forall (t :: * -> *) (f :: * -> *) b.
(PTraversable t, Divisible f, Decidable f) =>
f b -> f (t b)
coenum1 (Equivalence a -> Equivalence (t a))
-> ((a -> a -> Bool) -> Equivalence a)
-> (a -> a -> Bool)
-> Equivalence (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> Equivalence a
forall a. (a -> a -> Bool) -> Equivalence a
Equivalence
{-# INLINEABLE liftEq' #-}
liftEqDefault :: (PTraversable t) => (a -> b -> Bool) -> t a -> t b -> Bool
liftEqDefault :: forall (t :: * -> *) a b.
PTraversable t =>
(a -> b -> Bool) -> t a -> t b -> Bool
liftEqDefault a -> b -> Bool
eq t a
ta t b
tb = t (Either a b) -> t (Either a b) -> Bool
eqEithers (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> t a -> t (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a
ta) (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> t b -> t (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t b
tb)
where
eqEithers :: t (Either a b) -> t (Either a b) -> Bool
eqEithers = Equivalence (t (Either a b))
-> t (Either a b) -> t (Either a b) -> Bool
forall a. Equivalence a -> a -> a -> Bool
getEquivalence (Equivalence (t (Either a b))
-> t (Either a b) -> t (Either a b) -> Bool)
-> (Equivalence (Either a b) -> Equivalence (t (Either a b)))
-> Equivalence (Either a b)
-> t (Either a b)
-> t (Either a b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Equivalence (Either a b) -> Equivalence (t (Either a b))
forall (t :: * -> *) (f :: * -> *) b.
(PTraversable t, Divisible f, Decidable f) =>
f b -> f (t b)
coenum1 (Equivalence (Either a b)
-> t (Either a b) -> t (Either a b) -> Bool)
-> Equivalence (Either a b)
-> t (Either a b)
-> t (Either a b)
-> Bool
forall a b. (a -> b) -> a -> b
$ (Either a b -> Either a b -> Bool) -> Equivalence (Either a b)
forall a. (a -> a -> Bool) -> Equivalence a
Equivalence Either a b -> Either a b -> Bool
eq'
eq' :: Either a b -> Either a b -> Bool
eq' (Left a
_) (Left a
_) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"liftEqDefault: should be unreachable here"
eq' (Right b
_) (Right b
_) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"liftEqDefault: should be unreachable here"
eq' (Left a
a) (Right b
b) = a -> b -> Bool
eq a
a b
b
eq' (Right b
b) (Left a
a) = a -> b -> Bool
eq a
a b
b
eq1Default :: (PTraversable t, Eq a) => t a -> t a -> Bool
eq1Default :: forall (t :: * -> *) a.
(PTraversable t, Eq a) =>
t a -> t a -> Bool
eq1Default = (a -> a -> Bool) -> t a -> t a -> Bool
forall (t :: * -> *) a.
PTraversable t =>
(a -> a -> Bool) -> t a -> t a -> Bool
liftEq' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINEABLE eq1Default #-}
liftCompare' :: (PTraversable t) => (a -> a -> Ordering) -> t a -> t a -> Ordering
liftCompare' :: forall (t :: * -> *) a.
PTraversable t =>
(a -> a -> Ordering) -> t a -> t a -> Ordering
liftCompare' = Comparison (t a) -> t a -> t a -> Ordering
forall a. Comparison a -> a -> a -> Ordering
getComparison (Comparison (t a) -> t a -> t a -> Ordering)
-> ((a -> a -> Ordering) -> Comparison (t a))
-> (a -> a -> Ordering)
-> t a
-> t a
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comparison a -> Comparison (t a)
forall (t :: * -> *) (f :: * -> *) b.
(PTraversable t, Divisible f, Decidable f) =>
f b -> f (t b)
coenum1 (Comparison a -> Comparison (t a))
-> ((a -> a -> Ordering) -> Comparison a)
-> (a -> a -> Ordering)
-> Comparison (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> Comparison a
forall a. (a -> a -> Ordering) -> Comparison a
Comparison
{-# INLINEABLE liftCompare' #-}
compare1Default :: (PTraversable t, Ord a) => t a -> t a -> Ordering
compare1Default :: forall (t :: * -> *) a.
(PTraversable t, Ord a) =>
t a -> t a -> Ordering
compare1Default = (a -> a -> Ordering) -> t a -> t a -> Ordering
forall (t :: * -> *) a.
PTraversable t =>
(a -> a -> Ordering) -> t a -> t a -> Ordering
liftCompare' a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINEABLE compare1Default #-}
liftCompareDefault :: (PTraversable t) => (a -> b -> Ordering) -> t a -> t b -> Ordering
liftCompareDefault :: forall (t :: * -> *) a b.
PTraversable t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
liftCompareDefault a -> b -> Ordering
cmp t a
ta t b
tb = t (Either a b) -> t (Either a b) -> Ordering
cmpEithers (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> t a -> t (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a
ta) (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> t b -> t (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t b
tb)
where
cmpEithers :: t (Either a b) -> t (Either a b) -> Ordering
cmpEithers = Comparison (t (Either a b))
-> t (Either a b) -> t (Either a b) -> Ordering
forall a. Comparison a -> a -> a -> Ordering
getComparison (Comparison (t (Either a b))
-> t (Either a b) -> t (Either a b) -> Ordering)
-> (Comparison (Either a b) -> Comparison (t (Either a b)))
-> Comparison (Either a b)
-> t (Either a b)
-> t (Either a b)
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comparison (Either a b) -> Comparison (t (Either a b))
forall (t :: * -> *) (f :: * -> *) b.
(PTraversable t, Divisible f, Decidable f) =>
f b -> f (t b)
coenum1 (Comparison (Either a b)
-> t (Either a b) -> t (Either a b) -> Ordering)
-> Comparison (Either a b)
-> t (Either a b)
-> t (Either a b)
-> Ordering
forall a b. (a -> b) -> a -> b
$ (Either a b -> Either a b -> Ordering) -> Comparison (Either a b)
forall a. (a -> a -> Ordering) -> Comparison a
Comparison Either a b -> Either a b -> Ordering
cmp'
cmp' :: Either a b -> Either a b -> Ordering
cmp' (Left a
_) (Left a
_) = [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"liftCompareDefault: should be unreachable here"
cmp' (Right b
_) (Right b
_) = [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"liftCompareDefault: should be unreachable here"
cmp' (Left a
a) (Right b
b) = a -> b -> Ordering
cmp a
a b
b
cmp' (Right b
b) (Left a
a) = case a -> b -> Ordering
cmp a
a b
b of
Ordering
EQ -> Ordering
EQ
Ordering
LT -> Ordering
GT
Ordering
GT -> Ordering
LT
cardinality1 :: forall t proxy. (PTraversable t) => proxy t -> Int -> Int
cardinality1 :: forall (t :: * -> *) (proxy :: (* -> *) -> *).
PTraversable t =>
proxy t -> Int -> Int
cardinality1 proxy t
_ = Counting (t Any) (t Any) -> Int
forall a b. Counting a b -> Int
getCounting (Counting (t Any) (t Any) -> Int)
-> (Int -> Counting (t Any) (t Any)) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse @t (Counting Any Any -> Counting (t Any) (t Any))
-> (Int -> Counting Any Any) -> Int -> Counting (t Any) (t Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Counting Any Any
forall a b. Int -> Counting a b
Counting
{-# INLINEABLE cardinality1 #-}
unGenerically1 :: Generically1 f a -> f a
unGenerically1 :: forall (f :: * -> *) a. Generically1 f a -> f a
unGenerically1 = Generically1 f a -> f a
forall a b. Coercible a b => a -> b
coerce
instance (Generic1 t, PTraversable (Rep1 t)) => PTraversable (Generically1 t) where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> Generically1 t a)
-> (Generically1 t b -> bs) -> p a b -> p as bs
ptraverseWith as -> Generically1 t a
f Generically1 t b -> bs
g = (as -> Rep1 t a) -> (Rep1 t b -> bs) -> p a b -> p as bs
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> Rep1 t a) -> (Rep1 t b -> bs) -> p a b -> p as bs
ptraverseWith (t a -> Rep1 t a
forall a. t a -> Rep1 t a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (t a -> Rep1 t a) -> (as -> t a) -> as -> Rep1 t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Generically1 t a -> t a
forall (f :: * -> *) a. Generically1 f a -> f a
unGenerically1 (Generically1 t a -> t a) -> (as -> Generically1 t a) -> as -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. as -> Generically1 t a
f) (Generically1 t b -> bs
g (Generically1 t b -> bs)
-> (Rep1 t b -> Generically1 t b) -> Rep1 t b -> bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> Generically1 t b
forall {k} (f :: k -> *) (a :: k). f a -> Generically1 f a
Generically1 (t b -> Generically1 t b)
-> (Rep1 t b -> t b) -> Rep1 t b -> Generically1 t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep1 t b -> t b
forall a. Rep1 t a -> t a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1)
{-# INLINEABLE ptraverseWith #-}
deriving via (Generically1 Identity) instance PTraversable Identity
deriving via (Generically1 Maybe) instance PTraversable Maybe
deriving via (Generically1 []) instance PTraversable []
deriving
via (Generically1 ((,) a))
instance (Enum a) => PTraversable ((,) a)
deriving
via (Generically1 (Either a))
instance (Enum a) => PTraversable (Either a)
deriving via
(Generically1 (Sum t u))
instance
(PTraversable t, PTraversable u) => PTraversable (Sum t u)
deriving via
(Generically1 (Product t u))
instance
(PTraversable t, PTraversable u) => PTraversable (Product t u)
deriving via
(Generically1 (Compose t u))
instance
(PTraversable t, PTraversable u) => PTraversable (Compose t u)
ptraverseDay
:: (PTraversable t, PTraversable u)
=> (Cartesian p, Cocartesian p)
=> p a b -> p (Day t u a) (Day t u b)
ptraverseDay :: forall (t :: * -> *) (u :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, PTraversable u, Cartesian p, Cocartesian p) =>
p a b -> p (Day t u a) (Day t u b)
ptraverseDay = PT t -> PT u -> p a b -> p (Day t u a) (Day t u b)
forall (t :: * -> *) (u :: * -> *) (p :: * -> * -> *) a b.
(Cartesian p, Cocartesian p) =>
PT t -> PT u -> p a b -> p (Day t u a) (Day t u b)
DayImpl.ptraverseDay p a b -> p (t a) (t b)
PT t
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse p a b -> p (u a) (u b)
PT u
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse
ptraverseDayWith
:: (PTraversable t, PTraversable u)
=> (Cartesian p, Cocartesian p)
=> (x -> Day t u a) -> (Day t u b -> y) -> p a b -> p x y
ptraverseDayWith :: forall (t :: * -> *) (u :: * -> *) (p :: * -> * -> *) x a b y.
(PTraversable t, PTraversable u, Cartesian p, Cocartesian p) =>
(x -> Day t u a) -> (Day t u b -> y) -> p a b -> p x y
ptraverseDayWith x -> Day t u a
f Day t u b -> y
g = (x -> Day t u a)
-> (Day t u b -> y) -> p (Day t u a) (Day t u b) -> p x y
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap x -> Day t u a
f Day t u b -> y
g (p (Day t u a) (Day t u b) -> p x y)
-> (p a b -> p (Day t u a) (Day t u b)) -> p a b -> p x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Day t u a) (Day t u b)
forall (t :: * -> *) (u :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, PTraversable u, Cartesian p, Cocartesian p) =>
p a b -> p (Day t u a) (Day t u b)
ptraverseDay
newtype WrappedPTraversable t a = WrapPTraversable {forall (t :: * -> *) a. WrappedPTraversable t a -> t a
unwrapPTraversable :: t a}
deriving (Traversable (WrappedPTraversable t)
Ord1 (WrappedPTraversable t)
(Ord1 (WrappedPTraversable t),
Traversable (WrappedPTraversable t)) =>
(forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> WrappedPTraversable t a)
-> (WrappedPTraversable t b -> bs) -> p a b -> p as bs)
-> PTraversable (WrappedPTraversable t)
forall (t :: * -> *).
(Ord1 t, Traversable t) =>
(forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs)
-> PTraversable t
forall (t :: * -> *).
PTraversable t =>
Traversable (WrappedPTraversable t)
forall (t :: * -> *).
PTraversable t =>
Ord1 (WrappedPTraversable t)
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> WrappedPTraversable t a)
-> (WrappedPTraversable t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> WrappedPTraversable t a)
-> (WrappedPTraversable t b -> bs) -> p a b -> p as bs
$cptraverseWith :: forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> WrappedPTraversable t a)
-> (WrappedPTraversable t b -> bs) -> p a b -> p as bs
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> WrappedPTraversable t a)
-> (WrappedPTraversable t b -> bs) -> p a b -> p as bs
PTraversable) via t
instance (Eq a, PTraversable t) => Eq (WrappedPTraversable t a) where
== :: WrappedPTraversable t a -> WrappedPTraversable t a -> Bool
(==) = Clown Equivalence (t a) (t Any)
-> WrappedPTraversable t a -> WrappedPTraversable t a -> Bool
forall a b. Coercible a b => a -> b
coerce (Clown Equivalence (t a) (t Any)
-> WrappedPTraversable t a -> WrappedPTraversable t a -> Bool)
-> Clown Equivalence (t a) (t Any)
-> WrappedPTraversable t a
-> WrappedPTraversable t a
-> Bool
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse @t (Equivalence a -> Clown Equivalence a Any
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown Equivalence a
eqv)
where
eqv :: Equivalence a
eqv = (a -> a -> Bool) -> Equivalence a
forall a. (a -> a -> Bool) -> Equivalence a
Equivalence (forall a. Eq a => a -> a -> Bool
(==) @a)
instance PTraversable t => Eq1 (WrappedPTraversable t) where
liftEq :: forall a b.
(a -> b -> Bool)
-> WrappedPTraversable t a -> WrappedPTraversable t b -> Bool
liftEq = (a -> b -> Bool)
-> WrappedPTraversable t a -> WrappedPTraversable t b -> Bool
forall (t :: * -> *) a b.
PTraversable t =>
(a -> b -> Bool) -> t a -> t b -> Bool
liftEqDefault
instance (Ord a, PTraversable t) => Ord (WrappedPTraversable t a) where
compare :: WrappedPTraversable t a -> WrappedPTraversable t a -> Ordering
compare = Clown Comparison (t a) (t Any)
-> WrappedPTraversable t a -> WrappedPTraversable t a -> Ordering
forall a b. Coercible a b => a -> b
coerce (Clown Comparison (t a) (t Any)
-> WrappedPTraversable t a -> WrappedPTraversable t a -> Ordering)
-> Clown Comparison (t a) (t Any)
-> WrappedPTraversable t a
-> WrappedPTraversable t a
-> Ordering
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse @t (Comparison a -> Clown Comparison a Any
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown Comparison a
cmp)
where
cmp :: Comparison a
cmp = (a -> a -> Ordering) -> Comparison a
forall a. (a -> a -> Ordering) -> Comparison a
Comparison (forall a. Ord a => a -> a -> Ordering
compare @a)
instance PTraversable t => Ord1 (WrappedPTraversable t) where
liftCompare :: forall a b.
(a -> b -> Ordering)
-> WrappedPTraversable t a -> WrappedPTraversable t b -> Ordering
liftCompare = (a -> b -> Ordering)
-> WrappedPTraversable t a -> WrappedPTraversable t b -> Ordering
forall (t :: * -> *) a b.
PTraversable t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
liftCompareDefault
instance (Enum a, PTraversable t) => Enum (WrappedPTraversable t a) where
enumeration :: FinFn (WrappedPTraversable t a) (WrappedPTraversable t a)
enumeration = (WrappedPTraversable t a -> t a)
-> (t a -> WrappedPTraversable t a)
-> FinFn a a
-> FinFn (WrappedPTraversable t a) (WrappedPTraversable t a)
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
ptraverseWith WrappedPTraversable t a -> t a
forall (t :: * -> *) a. WrappedPTraversable t a -> t a
unwrapPTraversable t a -> WrappedPTraversable t a
forall (t :: * -> *) a. t a -> WrappedPTraversable t a
WrapPTraversable FinFn a a
forall x. Enum x => FinFn x x
enumeration
withEnum :: forall r.
(forall (n :: Nat).
KnownNat n =>
(WrappedPTraversable t a -> Finite n)
-> (Finite n -> WrappedPTraversable t a) -> r)
-> r
withEnum = FinFn (WrappedPTraversable t a) (WrappedPTraversable t a)
-> (forall (n :: Nat).
KnownNat n =>
(WrappedPTraversable t a -> Finite n)
-> (Finite n -> WrappedPTraversable t a) -> r)
-> r
forall a b r.
FinFn a b
-> (forall (n :: Nat).
KnownNat n =>
(a -> Finite n) -> (Finite n -> b) -> r)
-> r
withFinFn FinFn (WrappedPTraversable t a) (WrappedPTraversable t a)
forall x. Enum x => FinFn x x
enumeration
instance (PTraversable t) => Functor (WrappedPTraversable t) where
fmap :: forall a b.
(a -> b) -> WrappedPTraversable t a -> WrappedPTraversable t b
fmap a -> b
f = (t a -> t b) -> WrappedPTraversable t a -> WrappedPTraversable t b
forall a b. Coercible a b => a -> b
coerce (forall (t :: * -> *) a b. PTraversable t => (a -> b) -> t a -> t b
fmapDefault @t a -> b
f)
instance (PTraversable t) => Foldable (WrappedPTraversable t) where
foldMap :: forall m a. Monoid m => (a -> m) -> WrappedPTraversable t a -> m
foldMap a -> m
f = (t a -> m) -> WrappedPTraversable t a -> m
forall a b. Coercible a b => a -> b
coerce (forall (t :: * -> *) m a.
(PTraversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault @t a -> m
f)
instance (PTraversable t) => Traversable (WrappedPTraversable t) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> WrappedPTraversable t a -> f (WrappedPTraversable t b)
traverse a -> f b
f = (t b -> WrappedPTraversable t b)
-> f (t b) -> f (WrappedPTraversable t b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t b -> WrappedPTraversable t b
forall (t :: * -> *) a. t a -> WrappedPTraversable t a
WrapPTraversable (f (t b) -> f (WrappedPTraversable t b))
-> (WrappedPTraversable t a -> f (t b))
-> WrappedPTraversable t a
-> f (WrappedPTraversable t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(PTraversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverseDefault @t a -> f b
f (t a -> f (t b))
-> (WrappedPTraversable t a -> t a)
-> WrappedPTraversable t a
-> f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPTraversable t a -> t a
forall a b. Coercible a b => a -> b
coerce
instance PTraversable V1 where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> V1 a) -> (V1 b -> bs) -> p a b -> p as bs
ptraverseWith as -> V1 a
f V1 b -> bs
_ p a b
_ = (as -> Void) -> p Void bs -> p as bs
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (V1 a -> Void
forall a b. V1 a -> b
absurdV1 (V1 a -> Void) -> (as -> V1 a) -> as -> Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. as -> V1 a
f) p Void bs
forall b. p Void b
forall (p :: * -> * -> *) b. Cocartesian p => p Void b
proEmpty
{-# INLINEABLE ptraverseWith #-}
absurdV1 :: V1 a -> b
absurdV1 :: forall a b. V1 a -> b
absurdV1 V1 a
v = case V1 a
v of {}
instance PTraversable U1 where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> U1 a) -> (U1 b -> bs) -> p a b -> p as bs
ptraverseWith as -> U1 a
_ U1 b -> bs
g p a b
_ = (() -> bs) -> p as () -> p as bs
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap (bs -> () -> bs
forall a b. a -> b -> a
const (U1 b -> bs
g U1 b
forall k (p :: k). U1 p
U1)) p as ()
forall a. p a ()
forall (p :: * -> * -> *) a. Cartesian p => p a ()
proUnit
{-# INLINEABLE ptraverseWith #-}
instance PTraversable Par1 where
ptraverseWith :: forall p a b as bs. (Cartesian p, Cocartesian p) => (as -> Par1 a) -> (Par1 b -> bs) -> p a b -> p as bs
ptraverseWith :: forall (p :: * -> * -> *) a b as bs.
(Cartesian p, Cocartesian p) =>
(as -> Par1 a) -> (Par1 b -> bs) -> p a b -> p as bs
ptraverseWith = ((as -> a) -> (b -> bs) -> p a b -> p as bs)
-> (as -> Par1 a) -> (Par1 b -> bs) -> p a b -> p as bs
forall a b. Coercible a b => a -> b
coerce ((as -> a) -> (b -> bs) -> p a b -> p as bs
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap :: (as -> a) -> (b -> bs) -> p a b -> p as bs)
{-# INLINEABLE ptraverseWith #-}
instance (Enum c) => PTraversable (K1 i c) where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> K1 i c a) -> (K1 i c b -> bs) -> p a b -> p as bs
ptraverseWith as -> K1 i c a
f K1 i c b -> bs
g p a b
_ = (as -> c) -> (c -> bs) -> p c c -> p as bs
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (K1 i c a -> c
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 i c a -> c) -> (as -> K1 i c a) -> as -> c
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. as -> K1 i c a
f) (K1 i c b -> bs
g (K1 i c b -> bs) -> (c -> K1 i c b) -> c -> bs
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# c -> K1 i c b
forall k i c (p :: k). c -> K1 i c p
K1) p c c
forall x (p :: * -> * -> *).
(Enum x, Cartesian p, Cocartesian p) =>
p x x
describeEnum
instance (PTraversable f) => PTraversable (M1 i c f) where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> M1 i c f a) -> (M1 i c f b -> bs) -> p a b -> p as bs
ptraverseWith as -> M1 i c f a
f M1 i c f b -> bs
g = (as -> f a) -> (f b -> bs) -> p a b -> p as bs
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> f a) -> (f b -> bs) -> p a b -> p as bs
ptraverseWith (M1 i c f a -> f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 i c f a -> f a) -> (as -> M1 i c f a) -> as -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. as -> M1 i c f a
f) (M1 i c f b -> bs
g (M1 i c f b -> bs) -> (f b -> M1 i c f b) -> f b -> bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> M1 i c f b
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1)
{-# INLINEABLE ptraverseWith #-}
instance (PTraversable f) => PTraversable (Rec1 f) where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> Rec1 f a) -> (Rec1 f b -> bs) -> p a b -> p as bs
ptraverseWith as -> Rec1 f a
f Rec1 f b -> bs
g = (as -> f a) -> (f b -> bs) -> p a b -> p as bs
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> f a) -> (f b -> bs) -> p a b -> p as bs
ptraverseWith (Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1 (Rec1 f a -> f a) -> (as -> Rec1 f a) -> as -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. as -> Rec1 f a
f) (Rec1 f b -> bs
g (Rec1 f b -> bs) -> (f b -> Rec1 f b) -> f b -> bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Rec1 f b
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1)
{-# INLINEABLE ptraverseWith #-}
instance (PTraversable t, PTraversable u) => PTraversable (t :+: u) where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> (:+:) t u a) -> ((:+:) t u b -> bs) -> p a b -> p as bs
ptraverseWith as -> (:+:) t u a
f (:+:) t u b -> bs
g p a b
p = (as -> Either (t a) (u a))
-> (Either (t b) (u b) -> bs)
-> p (Either (t a) (u a)) (Either (t b) (u b))
-> p as bs
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap as -> Either (t a) (u a)
f' Either (t b) (u b) -> bs
g' (p (Either (t a) (u a)) (Either (t b) (u b)) -> p as bs)
-> p (Either (t a) (u a)) (Either (t b) (u b)) -> p as bs
forall a b. (a -> b) -> a -> b
$ p a b -> p (t a) (t b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse p a b
p p (t a) (t b)
-> p (u a) (u b) -> p (Either (t a) (u a)) (Either (t b) (u b))
forall a b a' b'. p a b -> p a' b' -> p (Either a a') (Either b b')
forall (p :: * -> * -> *) a b a' b'.
Cocartesian p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
+++ p a b -> p (u a) (u b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse p a b
p
where
f' :: as -> Either (t a) (u a)
f' as
as = case as -> (:+:) t u a
f as
as of
L1 t a
ta -> t a -> Either (t a) (u a)
forall a b. a -> Either a b
Left t a
ta
R1 u a
ua -> u a -> Either (t a) (u a)
forall a b. b -> Either a b
Right u a
ua
g' :: Either (t b) (u b) -> bs
g' = (t b -> bs) -> (u b -> bs) -> Either (t b) (u b) -> bs
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((:+:) t u b -> bs
g ((:+:) t u b -> bs) -> (t b -> (:+:) t u b) -> t b -> bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> (:+:) t u b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) ((:+:) t u b -> bs
g ((:+:) t u b -> bs) -> (u b -> (:+:) t u b) -> u b -> bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u b -> (:+:) t u b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1)
{-# INLINEABLE ptraverseWith #-}
instance (PTraversable f, PTraversable g) => PTraversable (f :*: g) where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> (:*:) f g a) -> ((:*:) f g b -> bs) -> p a b -> p as bs
ptraverseWith as -> (:*:) f g a
f (:*:) f g b -> bs
g p a b
p = (as -> (f a, g a))
-> ((f b, g b) -> bs) -> p (f a, g a) (f b, g b) -> p as bs
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap as -> (f a, g a)
f' (f b, g b) -> bs
g' (p (f a, g a) (f b, g b) -> p as bs)
-> p (f a, g a) (f b, g b) -> p as bs
forall a b. (a -> b) -> a -> b
$ p a b -> p (f a) (f b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse p a b
p p (f a) (f b) -> p (g a) (g b) -> p (f a, g a) (f b, g b)
forall a b a' b'. p a b -> p a' b' -> p (a, a') (b, b')
forall (p :: * -> * -> *) a b a' b'.
Cartesian p =>
p a b -> p a' b' -> p (a, a') (b, b')
*** p a b -> p (g a) (g b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse p a b
p
where
f' :: as -> (f a, g a)
f' as
as = case as -> (:*:) f g a
f as
as of
f a
ta :*: g a
ua -> (f a
ta, g a
ua)
g' :: (f b, g b) -> bs
g' (f b
ta, g b
ua) = (:*:) f g b -> bs
g (f b
ta f b -> g b -> (:*:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g b
ua)
{-# INLINEABLE ptraverseWith #-}
instance
(PTraversable t, PTraversable u) =>
PTraversable (t :.: u)
where
ptraverseWith :: forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> (:.:) t u a) -> ((:.:) t u b -> bs) -> p a b -> p as bs
ptraverseWith as -> (:.:) t u a
f (:.:) t u b -> bs
g = (as -> t (u a)) -> (t (u b) -> bs) -> p (u a) (u b) -> p as bs
forall (t :: * -> *) (p :: * -> * -> *) as a b bs.
(PTraversable t, Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
forall (p :: * -> * -> *) as a b bs.
(Cartesian p, Cocartesian p) =>
(as -> t a) -> (t b -> bs) -> p a b -> p as bs
ptraverseWith ((:.:) t u a -> t (u a)
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) t u a -> t (u a)) -> (as -> (:.:) t u a) -> as -> t (u a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. as -> (:.:) t u a
f) ((:.:) t u b -> bs
g ((:.:) t u b -> bs) -> (t (u b) -> (:.:) t u b) -> t (u b) -> bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (u b) -> (:.:) t u b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1) (p (u a) (u b) -> p as bs)
-> (p a b -> p (u a) (u b)) -> p a b -> p as bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (u a) (u b)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse
{-# INLINEABLE ptraverseWith #-}