{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
-- | This is **internal** module to break the import cycle.
--   The public API is to use "Data.PTraversable" instead.
module Data.PTraversable.Internal.ClassOnly(
  PTraversable(..),
  ptraverse,

  -- * Specialized traversals
  foldMapDefault,
  fmapDefault,
  traverseDefault,
  enum1,
  coenum1,
  cardinality1,

  -- * Default Eq/Ord
  liftEq',
  liftEqDefault,
  eq1Default,
  liftCompare',
  liftCompareDefault,
  compare1Default
) where

import Data.Profunctor.Cartesian (Cartesian, Cocartesian)
import Data.Functor.Classes (Ord1)
import Control.Applicative (Alternative)
import Data.Functor.Contravariant.Divisible (Divisible, Decidable)
import Data.Profunctor (Forget(..), Star (..))
import Data.Bifunctor.Joker (Joker(..))
import Data.Bifunctor.Clown (Clown(..))
import Data.Functor.Contravariant (Equivalence(..), Comparison (..))
import Data.Profunctor.Counting (Counting(..))

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 (ZonkAny 0)) -> t a -> m
forall {k} r a (b :: k). Forget r a b -> a -> r
runForget (Forget m (t a) (t (ZonkAny 0)) -> t a -> m)
-> ((a -> m) -> Forget m (t a) (t (ZonkAny 0)))
-> (a -> m)
-> t a
-> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forget m a (ZonkAny 0) -> Forget m (t a) (t (ZonkAny 0))
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Forget m a (ZonkAny 0) -> Forget m (t a) (t (ZonkAny 0)))
-> ((a -> m) -> Forget m a (ZonkAny 0))
-> (a -> m)
-> Forget m (t a) (t (ZonkAny 0))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m) -> Forget m a (ZonkAny 0)
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 (ZonkAny 1)) (t a) -> f (t a)
forall {k1} {k2} (g :: k1 -> *) (a :: k2) (b :: k1).
Joker g a b -> g b
runJoker (Joker f (t (ZonkAny 1)) (t a) -> f (t a))
-> (f a -> Joker f (t (ZonkAny 1)) (t a)) -> f a -> f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker f (ZonkAny 1) a -> Joker f (t (ZonkAny 1)) (t a)
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Joker f (ZonkAny 1) a -> Joker f (t (ZonkAny 1)) (t a))
-> (f a -> Joker f (ZonkAny 1) a)
-> f a
-> Joker f (t (ZonkAny 1)) (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Joker f (ZonkAny 1) 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 (ZonkAny 2)) -> f (t b)
forall {k1} {k2} (f :: k1 -> *) (a :: k1) (b :: k2).
Clown f a b -> f a
runClown (Clown f (t b) (t (ZonkAny 2)) -> f (t b))
-> (f b -> Clown f (t b) (t (ZonkAny 2))) -> f b -> f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f b (ZonkAny 2) -> Clown f (t b) (t (ZonkAny 2))
forall (t :: * -> *) (p :: * -> * -> *) a b.
(PTraversable t, Cartesian p, Cocartesian p) =>
p a b -> p (t a) (t b)
ptraverse (Clown f b (ZonkAny 2) -> Clown f (t b) (t (ZonkAny 2)))
-> (f b -> Clown f b (ZonkAny 2))
-> f b
-> Clown f (t b) (t (ZonkAny 2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> Clown f b (ZonkAny 2)
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown
{-# INLINEABLE coenum1 #-}

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 (ZonkAny 3)) (t (ZonkAny 4)) -> Int
forall a b. Counting a b -> Int
getCounting (Counting (t (ZonkAny 3)) (t (ZonkAny 4)) -> Int)
-> (Int -> Counting (t (ZonkAny 3)) (t (ZonkAny 4))) -> 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 (ZonkAny 3) (ZonkAny 4)
 -> Counting (t (ZonkAny 3)) (t (ZonkAny 4)))
-> (Int -> Counting (ZonkAny 3) (ZonkAny 4))
-> Int
-> Counting (t (ZonkAny 3)) (t (ZonkAny 4))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Counting (ZonkAny 3) (ZonkAny 4)
forall a b. Int -> Counting a b
Counting
{-# INLINEABLE cardinality1 #-}

-- | Type-restricted version of 'Data.Functor.Classes.liftEq'.
--
-- @
-- liftEq  :: forall t a b. (Eq1 t) => (a -> b -> Bool) -> t a -> t b -> Bool
-- liftEq' :: forall t a.   (.....) => (a -> a -> Bool) -> t a -> t a -> Bool
-- @
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 #-}

-- | Type-restricted version of 'Data.Functor.Classes.liftCompare'.
--
-- @
-- liftEq  :: forall t a b. (Eq1 t) => (a -> b -> Bool) -> t a -> t b -> Bool
-- liftEq' :: forall t a.   (.....) => (a -> a -> Bool) -> t a -> t a -> Bool
-- @
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 = (Either a b -> Either a b -> Ordering)
-> t (Either a b) -> t (Either a b) -> Ordering
forall (t :: * -> *) a.
PTraversable t =>
(a -> a -> Ordering) -> t a -> t a -> Ordering
liftCompare' 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