{-# 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 :: forall (t :: * -> *) (x :: k).
Applicative t =>
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
    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE gtraverse #-}

instance GTraversable n f g V1 V1 where
  gtraverse :: forall (t :: * -> *) (x :: k).
Applicative t =>
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
_ = forall a. HasCallStack => a
undefined
  {-# INLINE gtraverse #-}

instance GTraversable n f g U1 U1 where
  gtraverse :: forall (t :: * -> *) (x :: k).
Applicative t =>
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)
_ = 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 :: forall (t :: * -> *) (x :: k).
Applicative t =>
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)
    = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall (t :: * -> *) (x :: k).
Applicative t =>
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 -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (t :: * -> *) (x :: k).
Applicative t =>
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
    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: k). f a -> t (g a)
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} p a (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 :: forall (t :: * -> *) (x :: k).
Applicative t =>
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
    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: k). f a -> t (g a)
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} p a (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 :: forall (t :: * -> *) (x :: k).
Applicative t =>
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)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE gtraverse #-}
-- }} Not a functor application -----------------------------------------------