{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- This module provides 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 #-}

-- | This is **internal** module to break the import cycle.
--   The public API is to use "Data.PTraversable" instead.
module Data.PTraversable.Internal.Generics
  (
  -- Instance only; no exported names
  )
where

import Data.Coerce (coerce)
import Data.Finitary.Enum (Enum, describeEnum)
import Data.PTraversable.Internal.ClassOnly
import Data.Profunctor (Profunctor (..))
import Data.Profunctor.Cartesian
import Data.Profunctor.Unsafe ((#.), (.#))
import GHC.Generics
import GHC.Generics.Orphans ()
import Prelude hiding (Enum)

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
{-# INLINEABLE unGenerically1 #-}

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 #-}

---- Generics ----

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 #-}