{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
-- This module provides non-Generics-related instances for
-- PTraversable.
-- Since they are defined in Data.PTraversable.Internal.ClassOnly,
-- they are orphans instances, but that is expected.
{-# OPTIONS_GHC -Wno-orphans #-}

module Data.PTraversable.Internal.Instances (
  WrappedPTraversable(..)
) where

import Prelude hiding (Enum)
import Data.Finitary.Enum (Enum (..))
import Data.Profunctor.FinFn (withFinFn)

import Data.Coerce (coerce)
import Data.Functor.Classes (Eq1 (..), Ord1 (..))
import GHC.Generics (Generically1 (..))

import Data.Functor.Compose (Compose)
import Data.Functor.Identity (Identity)
import Data.Functor.Product (Product)
import Data.Functor.Sum (Sum)

import Data.PTraversable.Internal.ClassOnly
import Data.PTraversable.Internal.Generics ()

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
(==) = WrappedPTraversable t a -> WrappedPTraversable t a -> Bool
forall (t :: * -> *) a.
(PTraversable t, Eq a) =>
t a -> t a -> Bool
eq1Default

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 = WrappedPTraversable t a -> WrappedPTraversable t a -> Ordering
forall (t :: * -> *) a.
(PTraversable t, Ord a) =>
t a -> t a -> Ordering
compare1Default

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

-- Orphan Instances --

deriving via (Generically1 Identity) instance PTraversable Identity

deriving via (Generically1 Maybe) instance PTraversable Maybe

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)