{-# LANGUAGE AllowAmbiguousTypes #-}
{-# 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 UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Utils.GTraversable where

import qualified Data.Map as M
import Data.Morpheus.Kind
import Data.Morpheus.NamedResolvers (NamedResolverT)
import Data.Morpheus.Server.Deriving.Utils.Kinded
import Data.Morpheus.Server.Types.GQLType (GQLType (KIND, __type), TypeData (gqlFingerprint))
import Data.Morpheus.Server.Types.SchemaT (TypeFingerprint)
import Data.Morpheus.Types.Internal.AST
import GHC.Generics
import Relude hiding (Undefined)

traverseTypes ::
  (GFmap (ScanConstraint c) (KIND a) a, c (KIND a) a, GQLType a) =>
  Mappable c v KindedProxy ->
  Proxy a ->
  Map TypeFingerprint v
traverseTypes :: forall (c :: DerivingKind -> * -> Constraint) a v.
(GFmap (ScanConstraint c) (KIND a) a, c (KIND a) a, GQLType a) =>
Mappable c v KindedProxy -> Proxy a -> Map TypeFingerprint v
traverseTypes Mappable c v KindedProxy
f = forall (c :: DerivingKind -> * -> Constraint) v
       (f :: DerivingKind -> * -> *).
Mappable c v f
-> forall a.
   (GQLType a, c (KIND a) a) =>
   KindedProxy (KIND a) a -> v
runMappable (forall (c :: DerivingKind -> * -> Constraint) v.
Mappable c v KindedProxy
-> Map TypeFingerprint v
-> Mappable (ScanConstraint c) (Map TypeFingerprint v) KindedProxy
scanner Mappable c v KindedProxy
f forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (proxy :: * -> *) a. proxy a -> KindedProxy (KIND a) a
withDerivable

class
  (GFmap (ScanConstraint c) (KIND a) a, c (KIND a) a) =>
  ScanConstraint
    (c :: DerivingKind -> Type -> Constraint)
    (k :: DerivingKind)
    (a :: Type)

instance (GFmap (ScanConstraint c) (KIND a) a, c (KIND a) a) => ScanConstraint c k a

scanner ::
  Mappable c v KindedProxy ->
  Map TypeFingerprint v ->
  Mappable (ScanConstraint c) (Map TypeFingerprint v) KindedProxy
scanner :: forall (c :: DerivingKind -> * -> Constraint) v.
Mappable c v KindedProxy
-> Map TypeFingerprint v
-> Mappable (ScanConstraint c) (Map TypeFingerprint v) KindedProxy
scanner c :: Mappable c v KindedProxy
c@(Mappable forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
f) Map TypeFingerprint v
lib =
  forall (c :: DerivingKind -> * -> Constraint) v
       (f :: DerivingKind -> * -> *).
(forall a.
 (GQLType a, c (KIND a) a) =>
 KindedProxy (KIND a) a -> v)
-> Mappable c v f
Mappable
    ( \KindedProxy (KIND a) a
proxy -> do
        let typeInfo :: TypeData
typeInfo = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type KindedProxy (KIND a) a
proxy TypeCategory
OUT
        let fingerprint :: TypeFingerprint
fingerprint = TypeData -> TypeFingerprint
gqlFingerprint TypeData
typeInfo
        if forall k a. Ord k => k -> Map k a -> Bool
M.member TypeFingerprint
fingerprint Map TypeFingerprint v
lib
          then Map TypeFingerprint v
lib
          else do
            let newLib :: Map TypeFingerprint v
newLib = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert TypeFingerprint
fingerprint (forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
f KindedProxy (KIND a) a
proxy) Map TypeFingerprint v
lib
            forall {k} (c :: DerivingKind -> * -> Constraint)
       (t :: DerivingKind) (a :: k) v (kinded :: DerivingKind -> k -> *).
(GFmap c t a, Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded t a -> v
gfmap (forall (c :: DerivingKind -> * -> Constraint) v.
Mappable c v KindedProxy
-> Map TypeFingerprint v
-> Mappable (ScanConstraint c) (Map TypeFingerprint v) KindedProxy
scanner Mappable c v KindedProxy
c Map TypeFingerprint v
newLib) KindedProxy (KIND a) a
proxy
    )

withDerivable :: proxy a -> KindedProxy (KIND a) a
withDerivable :: forall (proxy :: * -> *) a. proxy a -> KindedProxy (KIND a) a
withDerivable proxy a
_ = forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy

newtype Mappable (c :: DerivingKind -> Type -> Constraint) (v :: Type) (f :: DerivingKind -> Type -> Type) = Mappable
  { forall (c :: DerivingKind -> * -> Constraint) v
       (f :: DerivingKind -> * -> *).
Mappable c v f
-> forall a.
   (GQLType a, c (KIND a) a) =>
   KindedProxy (KIND a) a -> v
runMappable :: forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
  }

-- Map
class GFmap (c :: DerivingKind -> Type -> Constraint) (t :: DerivingKind) a where
  gfmap :: (Monoid v, Semigroup v) => Mappable c v KindedProxy -> kinded t a -> v

instance (GQLType a, c (KIND a) a) => GFmap c SCALAR a where
  gfmap :: forall v (kinded :: DerivingKind -> * -> *).
(Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded SCALAR a -> v
gfmap (Mappable forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
f) kinded SCALAR a
_ = forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
f (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)

instance (GQLType a, c (KIND a) a, GFunctor c (Rep a)) => GFmap c TYPE a where
  gfmap :: forall v (kinded :: DerivingKind -> * -> *).
(Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded TYPE a -> v
gfmap f :: Mappable c v KindedProxy
f@(Mappable forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
fx) kinded TYPE a
_ = forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
fx (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a) forall a. Semigroup a => a -> a -> a
<> forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable c v KindedProxy
f (forall {k} (t :: k). Proxy t
Proxy @(Rep a))

instance GFmap c (KIND a) a => GFmap c WRAPPER (f a) where
  gfmap :: forall v (kinded :: DerivingKind -> k -> *).
(Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded WRAPPER (f a) -> v
gfmap Mappable c v KindedProxy
f kinded WRAPPER (f a)
_ = forall {k} (c :: DerivingKind -> * -> Constraint)
       (t :: DerivingKind) (a :: k) v (kinded :: DerivingKind -> k -> *).
(GFmap c t a, Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded t a -> v
gfmap Mappable c v KindedProxy
f (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)

instance GFmap c (KIND a) a => GFmap c CUSTOM (input -> a) where
  gfmap :: forall v (kinded :: DerivingKind -> * -> *).
(Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded CUSTOM (input -> a) -> v
gfmap Mappable c v KindedProxy
f kinded CUSTOM (input -> a)
_ = forall {k} (c :: DerivingKind -> * -> Constraint)
       (t :: DerivingKind) (a :: k) v (kinded :: DerivingKind -> k -> *).
(GFmap c t a, Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded t a -> v
gfmap Mappable c v KindedProxy
f (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)

instance GFmap c (KIND a) a => GFmap c CUSTOM (NamedResolverT m a) where
  gfmap :: forall v (kinded :: DerivingKind -> * -> *).
(Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded CUSTOM (NamedResolverT m a) -> v
gfmap Mappable c v KindedProxy
f kinded CUSTOM (NamedResolverT m a)
_ = forall {k} (c :: DerivingKind -> * -> Constraint)
       (t :: DerivingKind) (a :: k) v (kinded :: DerivingKind -> k -> *).
(GFmap c t a, Monoid v, Semigroup v) =>
Mappable c v KindedProxy -> kinded t a -> v
gfmap Mappable c v KindedProxy
f (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)

--
--
-- GFunctor
--
--
class GFunctor (c :: DerivingKind -> Type -> Constraint) a where
  genericMap :: (Monoid v, Semigroup v) => Mappable c v p -> proxy a -> v

instance (Datatype d, GFunctor c a) => GFunctor c (M1 D d a) where
  genericMap :: forall v (p :: DerivingKind -> * -> *) (proxy :: (k -> *) -> *).
(Monoid v, Semigroup v) =>
Mappable c v p -> proxy (M1 D d a) -> v
genericMap Mappable c v p
fun proxy (M1 D d a)
_ = forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable c v p
fun (forall {k} (t :: k). Proxy t
Proxy @a)

instance (GFunctor con a) => GFunctor con (M1 C c a) where
  genericMap :: forall v (p :: DerivingKind -> * -> *) (proxy :: (k -> *) -> *).
(Monoid v, Semigroup v) =>
Mappable con v p -> proxy (M1 C c a) -> v
genericMap Mappable con v p
f proxy (M1 C c a)
_ = forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable con v p
f (forall {k} (t :: k). Proxy t
Proxy @a)

instance (GFunctor c a, GFunctor c b) => GFunctor c (a :+: b) where
  genericMap :: forall v (p :: DerivingKind -> * -> *) (proxy :: (k -> *) -> *).
(Monoid v, Semigroup v) =>
Mappable c v p -> proxy (a :+: b) -> v
genericMap Mappable c v p
fun proxy (a :+: b)
_ = forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable c v p
fun (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Semigroup a => a -> a -> a
<> forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable c v p
fun (forall {k} (t :: k). Proxy t
Proxy @b)

instance (GFunctor c a, GFunctor c b) => GFunctor c (a :*: b) where
  genericMap :: forall v (p :: DerivingKind -> * -> *) (proxy :: (k -> *) -> *).
(Monoid v, Semigroup v) =>
Mappable c v p -> proxy (a :*: b) -> v
genericMap Mappable c v p
fun proxy (a :*: b)
_ = forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable c v p
fun (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Semigroup a => a -> a -> a
<> forall {k} (c :: DerivingKind -> * -> Constraint) (a :: k) v
       (p :: DerivingKind -> * -> *) (proxy :: k -> *).
(GFunctor c a, Monoid v, Semigroup v) =>
Mappable c v p -> proxy a -> v
genericMap Mappable c v p
fun (forall {k} (t :: k). Proxy t
Proxy @b)

instance (GQLType a, c (KIND a) a) => GFunctor c (M1 S s (K1 x a)) where
  genericMap :: forall v (p :: DerivingKind -> * -> *) (proxy :: (k -> *) -> *).
(Monoid v, Semigroup v) =>
Mappable c v p -> proxy (M1 S s (K1 x a)) -> v
genericMap (Mappable forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
f) proxy (M1 S s (K1 x a))
_ = forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v
f (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)

instance GFunctor c U1 where
  genericMap :: forall v (p :: DerivingKind -> * -> *) (proxy :: (k -> *) -> *).
(Monoid v, Semigroup v) =>
Mappable c v p -> proxy U1 -> v
genericMap Mappable c v p
_ proxy U1
_ = forall a. Monoid a => a
mempty