{-# LANGUAGE PolyKinds #-}
module Barbies.Generics.Traversable
  ( GTraversable(..)
  )

where

import Data.Generics.GenericN
import Data.Proxy (Proxy (..))

class GTraversable n f g repbf repbg where
  gtraverse
    :: Applicative t
    => Proxy n
    -> (forall a . f a -> t (g a))
    -> repbf x
    -> t (repbg x)

-- ----------------------------------
-- Trivial cases
-- ----------------------------------

instance
  ( GTraversable n f g bf bg
  ) => GTraversable n f g (M1 i c bf) (M1 i c bg)
  where
  gtraverse :: Proxy n
-> (forall (a :: k). f a -> t (g a))
-> M1 i c bf x
-> t (M1 i c bg x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h
    = (bg x -> M1 i c bg x) -> t (bg x) -> t (M1 i c bg x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap bg x -> M1 i c bg x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (t (bg x) -> t (M1 i c bg x))
-> (M1 i c bf x -> t (bg x)) -> M1 i c bf x -> t (M1 i c bg x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> (forall (a :: k). f a -> t (g a)) -> bf x -> t (bg x)
forall k k k (n :: k) (f :: k -> *) (g :: k -> *) (repbf :: k -> *)
       (repbg :: k -> *) (t :: * -> *) (x :: k).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k). f a -> t (g a)) -> repbf x -> t (repbg x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h (bf x -> t (bg x))
-> (M1 i c bf x -> bf x) -> M1 i c bf x -> t (bg x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c bf x -> bf x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE gtraverse #-}

instance GTraversable n f g V1 V1 where
  gtraverse :: Proxy n -> (forall (a :: k). f a -> t (g a)) -> V1 x -> t (V1 x)
gtraverse Proxy n
_ forall (a :: k). f a -> t (g a)
_ V1 x
_ = t (V1 x)
forall a. HasCallStack => a
undefined
  {-# INLINE gtraverse #-}

instance GTraversable n f g U1 U1 where
  gtraverse :: Proxy n -> (forall (a :: k). f a -> t (g a)) -> U1 x -> t (U1 x)
gtraverse Proxy n
_ forall (a :: k). f a -> t (g a)
_ = U1 x -> t (U1 x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE gtraverse #-}

instance
  ( GTraversable n f g l l'
  , GTraversable n f g r r'
  ) => GTraversable n f g (l :*: r) (l' :*: r')
  where
  gtraverse :: Proxy n
-> (forall (a :: k). f a -> t (g a))
-> (:*:) l r x
-> t ((:*:) l' r' x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h (l x
l :*: r x
r)
    = l' x -> r' x -> (:*:) l' r' x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (l' x -> r' x -> (:*:) l' r' x)
-> t (l' x) -> t (r' x -> (:*:) l' r' x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy n -> (forall (a :: k). f a -> t (g a)) -> l x -> t (l' x)
forall k k k (n :: k) (f :: k -> *) (g :: k -> *) (repbf :: k -> *)
       (repbg :: k -> *) (t :: * -> *) (x :: k).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k). f a -> t (g a)) -> repbf x -> t (repbg x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h l x
l t (r' x -> (:*:) l' r' x) -> t (r' x) -> t ((:*:) l' r' x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy n -> (forall (a :: k). f a -> t (g a)) -> r x -> t (r' x)
forall k k k (n :: k) (f :: k -> *) (g :: k -> *) (repbf :: k -> *)
       (repbg :: k -> *) (t :: * -> *) (x :: k).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k). f a -> t (g a)) -> repbf x -> t (repbg x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h r x
r
  {-# INLINE gtraverse #-}

instance
  ( GTraversable n f g l l'
  , GTraversable n f g r r'
  ) => GTraversable n f g (l :+: r) (l' :+: r')
  where
  gtraverse :: Proxy n
-> (forall (a :: k). f a -> t (g a))
-> (:+:) l r x
-> t ((:+:) l' r' x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h = \case
    L1 l x
l -> l' x -> (:+:) l' r' x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (l' x -> (:+:) l' r' x) -> t (l' x) -> t ((:+:) l' r' x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy n -> (forall (a :: k). f a -> t (g a)) -> l x -> t (l' x)
forall k k k (n :: k) (f :: k -> *) (g :: k -> *) (repbf :: k -> *)
       (repbg :: k -> *) (t :: * -> *) (x :: k).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k). f a -> t (g a)) -> repbf x -> t (repbg x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h l x
l
    R1 r x
r -> r' x -> (:+:) l' r' x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (r' x -> (:+:) l' r' x) -> t (r' x) -> t ((:+:) l' r' x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy n -> (forall (a :: k). f a -> t (g a)) -> r x -> t (r' x)
forall k k k (n :: k) (f :: k -> *) (g :: k -> *) (repbf :: k -> *)
       (repbg :: k -> *) (t :: * -> *) (x :: k).
(GTraversable n f g repbf repbg, Applicative t) =>
Proxy n
-> (forall (a :: k). f a -> t (g a)) -> repbf x -> t (repbg x)
gtraverse Proxy n
pn forall (a :: k). f a -> t (g a)
h r x
r
  {-# INLINE gtraverse #-}

-- --------------------------------
-- The interesting cases
-- --------------------------------

type P = Param

-- {{ Functor application ------------------------------------------------------
instance
  GTraversable n f g (Rec (P n f a') (f a))
                     (Rec (P n g a') (g a))
  where
  gtraverse :: Proxy n
-> (forall (a :: k). f a -> t (g a))
-> Rec (P n f a') (f a) x
-> t (Rec (P n g a') (g a) x)
gtraverse Proxy n
_ forall (a :: k). f a -> t (g a)
h
    = (g a -> Rec (P n g a') (g a) x)
-> t (g a) -> t (Rec (P n g a') (g a) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (g a) x -> Rec (P n g a') (g a) x
forall k p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (g a) x -> Rec (P n g a') (g a) x)
-> (g a -> K1 R (g a) x) -> g a -> Rec (P n g a') (g a) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> K1 R (g a) x
forall k i c (p :: k). c -> K1 i c p
K1) (t (g a) -> t (Rec (P n g a') (g a) x))
-> (Rec (P n f a') (f a) x -> t (g a))
-> Rec (P n f a') (f a) x
-> t (Rec (P n g a') (g a) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> t (g a)
forall (a :: k). f a -> t (g a)
h (f a -> t (g a))
-> (Rec (P n f a') (f a) x -> f a)
-> Rec (P n f a') (f a) x
-> t (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (f a) x -> f a
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R (f a) x -> f a)
-> (Rec (P n f a') (f a) x -> K1 R (f a) x)
-> Rec (P n f a') (f a) x
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (P n f a') (f a) x -> K1 R (f a) x
forall p a k (x :: k). Rec p a x -> K1 R a x
unRec
  {-# INLINE gtraverse #-}


instance
  ( Traversable h
  ) =>
  GTraversable n f g (Rec (h (P n f a)) (h (f a)))
                     (Rec (h (P n g a)) (h (g a)))
  where
  gtraverse :: Proxy n
-> (forall (a :: k). f a -> t (g a))
-> Rec (h (P n f a)) (h (f a)) x
-> t (Rec (h (P n g a)) (h (g a)) x)
gtraverse Proxy n
_ forall (a :: k). f a -> t (g a)
h
    = (h (g a) -> Rec (h (P n g a)) (h (g a)) x)
-> t (h (g a)) -> t (Rec (h (P n g a)) (h (g a)) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (h (g a)) x -> Rec (h (P n g a)) (h (g a)) x
forall k p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (h (g a)) x -> Rec (h (P n g a)) (h (g a)) x)
-> (h (g a) -> K1 R (h (g a)) x)
-> h (g a)
-> Rec (h (P n g a)) (h (g a)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (g a) -> K1 R (h (g a)) x
forall k i c (p :: k). c -> K1 i c p
K1) (t (h (g a)) -> t (Rec (h (P n g a)) (h (g a)) x))
-> (Rec (h (P n f a)) (h (f a)) x -> t (h (g a)))
-> Rec (h (P n f a)) (h (f a)) x
-> t (Rec (h (P n g a)) (h (g a)) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> t (g a)) -> h (f a) -> t (h (g a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse f a -> t (g a)
forall (a :: k). f a -> t (g a)
h (h (f a) -> t (h (g a)))
-> (Rec (h (P n f a)) (h (f a)) x -> h (f a))
-> Rec (h (P n f a)) (h (f a)) x
-> t (h (g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R (h (f a)) x -> h (f a)
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R (h (f a)) x -> h (f a))
-> (Rec (h (P n f a)) (h (f a)) x -> K1 R (h (f a)) x)
-> Rec (h (P n f a)) (h (f a)) x
-> h (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (h (P n f a)) (h (f a)) x -> K1 R (h (f a)) x
forall p a k (x :: k). Rec p a x -> K1 R a x
unRec
  {-# INLINE gtraverse #-}
-- }} Functor application ------------------------------------------------------


-- {{ Not a functor application -----------------------------------------------
instance GTraversable n f g (Rec a a) (Rec a a) where
  gtraverse :: Proxy n
-> (forall (a :: k). f a -> t (g a)) -> Rec a a x -> t (Rec a a x)
gtraverse Proxy n
_ forall (a :: k). f a -> t (g a)
_ = Rec a a x -> t (Rec a a x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE gtraverse #-}
-- }} Not a functor application -----------------------------------------------