{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Generic.Gmap
  ( Gmap,
    gmap,
  )
where

import Data.Morpheus.Generic.Proxy
  ( CProxy (..),
    rep,
  )
import GHC.Generics
  ( C,
    D,
    Datatype,
    Generic (..),
    K1,
    M1,
    S,
    U1,
    type (:*:),
    type (:+:),
  )
import Relude

-- newtype GmapFun (fun :: Type -> Constraint) (v :: Type) = GmapFun
--   { gmapFun :: forall f a. (fun a) => f a -> v
--   }

gmap :: (Gmap c (Rep a)) => f a -> [CProxy c]
gmap :: forall (c :: * -> Constraint) a (f :: * -> *).
Gmap c (Rep a) =>
f a -> [CProxy c]
gmap f a
p = Proxy (Rep a) -> [CProxy c]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (* -> *) -> *). f (Rep a) -> [CProxy c]
gfmap (f a -> Proxy (Rep a)
forall (f :: * -> *) a. f a -> Proxy (Rep a)
rep f a
p)

class Gmap (c :: Type -> Constraint) a where
  gfmap :: f a -> [CProxy c]

instance (Datatype d, Gmap c a) => Gmap c (M1 D d a) where
  gfmap :: forall (f :: (k -> *) -> *). f (M1 D d a) -> [CProxy c]
gfmap f (M1 D d a)
_ = Proxy a -> [CProxy c]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (k -> *) -> *). f a -> [CProxy c]
gfmap (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a)

instance (Gmap con a) => Gmap con (M1 C c a) where
  gfmap :: forall (f :: (k -> *) -> *). f (M1 C c a) -> [CProxy con]
gfmap f (M1 C c a)
_ = Proxy a -> [CProxy con]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (k -> *) -> *). f a -> [CProxy con]
gfmap (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a)

instance (Gmap c a, Gmap c b) => Gmap c (a :+: b) where
  gfmap :: forall (f :: (k -> *) -> *). f (a :+: b) -> [CProxy c]
gfmap f (a :+: b)
_ = Proxy a -> [CProxy c]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (k -> *) -> *). f a -> [CProxy c]
gfmap (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a) [CProxy c] -> [CProxy c] -> [CProxy c]
forall a. Semigroup a => a -> a -> a
<> Proxy b -> [CProxy c]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (k -> *) -> *). f b -> [CProxy c]
gfmap (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @b)

instance (Gmap c a, Gmap c b) => Gmap c (a :*: b) where
  gfmap :: forall (f :: (k -> *) -> *). f (a :*: b) -> [CProxy c]
gfmap f (a :*: b)
_ = Proxy a -> [CProxy c]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (k -> *) -> *). f a -> [CProxy c]
gfmap (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a) [CProxy c] -> [CProxy c] -> [CProxy c]
forall a. Semigroup a => a -> a -> a
<> Proxy b -> [CProxy c]
forall {k} (c :: * -> Constraint) (a :: k) (f :: k -> *).
Gmap c a =>
f a -> [CProxy c]
forall (f :: (k -> *) -> *). f b -> [CProxy c]
gfmap (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @b)

instance (c a) => Gmap c (M1 S s (K1 x a)) where
  gfmap :: forall (f :: (k -> *) -> *). f (M1 S s (K1 x a)) -> [CProxy c]
gfmap f (M1 S s (K1 x a))
_ = [Proxy a -> CProxy c
forall {k} (f :: k -> *) (constraint :: k -> Constraint) (a :: k).
constraint a =>
f a -> CProxy constraint
CProxy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)]

instance Gmap c U1 where
  gfmap :: forall (f :: (k -> *) -> *). f U1 -> [CProxy c]
gfmap f U1
_ = []