{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings     #-}
{-# language ScopedTypeVariables   #-}
{-# language TypeApplications      #-}
{-# language TypeFamilies          #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
module Mu.GraphQL.Query.Introspection where

import           Control.Monad.Writer
import qualified Data.Aeson           as JSON
import qualified Data.HashMap.Strict  as HM
import qualified Data.HashSet         as S
import           Data.Int             (Int32)
import           Data.Maybe           (catMaybes, fromMaybe)
import           Data.Proxy
import qualified Data.Text            as T
import           GHC.TypeLits
import           Mu.Rpc
import qualified Mu.Schema            as Mu

type TypeMap = HM.HashMap T.Text Type

data Schema
  = Schema { Schema -> Maybe Text
queryType        :: Maybe T.Text
           , Schema -> Maybe Text
mutationType     :: Maybe T.Text
           , Schema -> Maybe Text
subscriptionType :: Maybe T.Text
           , Schema -> TypeMap
types            :: TypeMap }
  deriving Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
(Int -> Schema -> ShowS)
-> (Schema -> String) -> ([Schema] -> ShowS) -> Show Schema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schema] -> ShowS
$cshowList :: [Schema] -> ShowS
show :: Schema -> String
$cshow :: Schema -> String
showsPrec :: Int -> Schema -> ShowS
$cshowsPrec :: Int -> Schema -> ShowS
Show

data Type
  = Type
    { Type -> TypeKind
kind          :: TypeKind
    , Type -> Maybe Text
typeName      :: Maybe T.Text
    , Type -> [Field]
fields        :: [Field]
    , Type -> [EnumValue]
enumValues    :: [EnumValue]
    , Type -> [Type]
possibleTypes :: [Type]
    , Type -> Maybe Type
ofType        :: Maybe Type
    }
  | TypeRef { Type -> Text
to :: T.Text }
  deriving Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show

data Field
  = Field
    { Field -> Text
fieldName :: T.Text
    , Field -> [Input]
args      :: [Input]
    , Field -> Type
fieldType :: Type
    }
  deriving Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show

data Input
  = Input
    { Input -> Text
inputName         :: T.Text
    , Input -> Maybe Text
inputDefaultValue :: Maybe T.Text
    , Input -> Type
inputType         :: Type
    }
  deriving Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show

newtype EnumValue
  = EnumValue { EnumValue -> Text
enumValueName :: T.Text }
  deriving Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> String
(Int -> EnumValue -> ShowS)
-> (EnumValue -> String)
-> ([EnumValue] -> ShowS)
-> Show EnumValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumValue] -> ShowS
$cshowList :: [EnumValue] -> ShowS
show :: EnumValue -> String
$cshow :: EnumValue -> String
showsPrec :: Int -> EnumValue -> ShowS
$cshowsPrec :: Int -> EnumValue -> ShowS
Show

data TypeKind
  = SCALAR
  | OBJECT
  | INTERFACE
  | UNION
  | ENUM
  | INPUT_OBJECT
  | LIST
  | NON_NULL
  deriving Int -> TypeKind -> ShowS
[TypeKind] -> ShowS
TypeKind -> String
(Int -> TypeKind -> ShowS)
-> (TypeKind -> String) -> ([TypeKind] -> ShowS) -> Show TypeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeKind] -> ShowS
$cshowList :: [TypeKind] -> ShowS
show :: TypeKind -> String
$cshow :: TypeKind -> String
showsPrec :: Int -> TypeKind -> ShowS
$cshowsPrec :: Int -> TypeKind -> ShowS
Show

tSimple :: T.Text -> Type
tSimple :: Text -> Type
tSimple Text
t = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
SCALAR (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) [] [] [] Maybe Type
forall a. Maybe a
Nothing

tList :: Type -> Type
tList :: Type -> Type
tList = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
LIST Maybe Text
forall a. Maybe a
Nothing [] [] [] (Maybe Type -> Type) -> (Type -> Maybe Type) -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Maybe Type
forall a. a -> Maybe a
Just

tNonNull :: Type -> Type
tNonNull :: Type -> Type
tNonNull = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
NON_NULL Maybe Text
forall a. Maybe a
Nothing [] [] [] (Maybe Type -> Type) -> (Type -> Maybe Type) -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Maybe Type
forall a. a -> Maybe a
Just

unwrapNonNull :: Type -> Maybe Type
unwrapNonNull :: Type -> Maybe Type
unwrapNonNull (Type TypeKind
NON_NULL Maybe Text
_ [Field]
_ [EnumValue]
_ [Type]
_ Maybe Type
x) = Maybe Type
x
unwrapNonNull Type
_                         = Maybe Type
forall a. Maybe a
Nothing

-- BUILD INTROSPECTION DATA
-- ========================

class Introspect (p :: Package')
                 (qr :: Maybe Symbol)
                 (mut :: Maybe Symbol)
                 (sub :: Maybe Symbol) where
  introspect
    :: Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema

instance ( IntrospectServices ss sub
         , KnownMaybeSymbol qr
         , KnownMaybeSymbol mut
         , KnownMaybeSymbol sub)
         => Introspect ('Package nm ss) qr mut sub where
  introspect :: Proxy ('Package nm ss)
-> Proxy qr -> Proxy mut -> Proxy sub -> Schema
introspect Proxy ('Package nm ss)
_ Proxy qr
_ Proxy mut
_ Proxy sub
_
    = let (()
_, TypeMap
ts) = Writer TypeMap () -> ((), TypeMap)
forall w a. Writer w a -> (a, w)
runWriter (Writer TypeMap () -> ((), TypeMap))
-> Writer TypeMap () -> ((), TypeMap)
forall a b. (a -> b) -> a -> b
$
           Proxy ss -> Proxy sub -> Writer TypeMap ()
forall (ss :: [Service']) (sub :: Maybe Symbol).
IntrospectServices ss sub =>
Proxy ss -> Proxy sub -> Writer TypeMap ()
introspectServices (Proxy ss
forall k (t :: k). Proxy t
Proxy @ss) (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub) Writer TypeMap () -> Writer TypeMap () -> Writer TypeMap ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
           TypeMap -> Writer TypeMap ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([(Text, Type)] -> TypeMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (
             (\Text
i -> (Text
i, Text -> Type
tSimple Text
i))
               (Text -> (Text, Type)) -> [Text] -> [(Text, Type)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Text
"Null", Text
"Int", Text
"Float"
                   , Text
"String", Text
"Boolean", Text
"ID"
                   , Text
"JSON", Text
"JSONObject" ] ))
          -- return only reachable types
          qrS :: Maybe Text
qrS  = Proxy qr -> Maybe Text
forall (s :: Maybe Symbol).
KnownMaybeSymbol s =>
Proxy s -> Maybe Text
maybeSymbolVal (Proxy qr
forall k (t :: k). Proxy t
Proxy @qr)
          mutS :: Maybe Text
mutS = Proxy mut -> Maybe Text
forall (s :: Maybe Symbol).
KnownMaybeSymbol s =>
Proxy s -> Maybe Text
maybeSymbolVal (Proxy mut
forall k (t :: k). Proxy t
Proxy @mut)
          subS :: Maybe Text
subS = Proxy sub -> Maybe Text
forall (s :: Maybe Symbol).
KnownMaybeSymbol s =>
Proxy s -> Maybe Text
maybeSymbolVal (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub)
          initials :: HashSet Text
initials = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
qrS, Maybe Text
mutS, Maybe Text
subS]
          reach :: HashSet Text
reach = TypeMap -> HashSet Text -> HashSet Text
reachableFrom TypeMap
ts HashSet Text
initials
          --
          finalTs :: TypeMap
finalTs = (Text -> Type -> Bool) -> TypeMap -> TypeMap
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey (\Text
k Type
_ -> Text
k Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Text
reach) TypeMap
ts
      in Maybe Text -> Maybe Text -> Maybe Text -> TypeMap -> Schema
Schema Maybe Text
qrS Maybe Text
mutS Maybe Text
subS TypeMap
finalTs

reachableFrom :: TypeMap -> S.HashSet T.Text -> S.HashSet T.Text
reachableFrom :: TypeMap -> HashSet Text -> HashSet Text
reachableFrom TypeMap
mp HashSet Text
tys
  = let tys' :: [Text]
tys' = HashSet Text -> [Text]
forall a. HashSet a -> [a]
S.toList HashSet Text
tys
        fromThis :: [HashSet Text]
fromThis = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([Text] -> HashSet Text)
-> (Text -> [Text]) -> Text -> HashSet Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
reachableFromOne (Text -> HashSet Text) -> [Text] -> [HashSet Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tys'
        allReachable :: HashSet Text
allReachable = [HashSet Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
S.unions [HashSet Text]
fromThis
    in if HashSet Text
tys HashSet Text -> HashSet Text -> Bool
forall a. Eq a => a -> a -> Bool
== HashSet Text
allReachable
          then HashSet Text
tys
          else TypeMap -> HashSet Text -> HashSet Text
reachableFrom TypeMap
mp HashSet Text
allReachable
  where
    reachableFromOne :: T.Text -> [T.Text]
    reachableFromOne :: Text -> [Text]
reachableFromOne Text
t
      = case Text -> TypeMap -> Maybe Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
t TypeMap
mp of
          Just ty :: Type
ty@Type {}
            -> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Field -> [Text]) -> [Field] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Field -> [Text]
reachableFromField (Type -> [Field]
fields Type
ty)
          Maybe Type
_ -> String -> [Text]
forall a. HasCallStack => String -> a
error String
"this should never happen"

    reachableFromField :: Field -> [T.Text]
    reachableFromField :: Field -> [Text]
reachableFromField Field
f
      = Type -> [Text]
reachableFromType (Field -> Type
fieldType Field
f) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Input -> [Text]) -> [Input] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Input -> [Text]
reachableFromInput (Field -> [Input]
args Field
f)

    reachableFromInput :: Input -> [T.Text]
    reachableFromInput :: Input -> [Text]
reachableFromInput Input
i = Type -> [Text]
reachableFromType (Input -> Type
inputType Input
i)

    reachableFromType :: Type -> [T.Text]
    reachableFromType :: Type -> [Text]
reachableFromType (TypeRef Text
t) = [Text
t]
    reachableFromType t :: Type
t@Type {}
      = case Type -> Maybe Type
ofType Type
t of
          Just Type
t' -> Type -> [Text]
reachableFromType Type
t'
          Maybe Type
Nothing -> case Type -> Maybe Text
typeName Type
t of
            Just Text
tn -> [Text
tn]
            Maybe Text
Nothing -> []

class KnownMaybeSymbol (s :: Maybe Symbol) where
  maybeSymbolVal :: Proxy s -> Maybe T.Text
instance KnownSymbol s => KnownMaybeSymbol ('Just s) where
  maybeSymbolVal :: Proxy ('Just s) -> Maybe Text
maybeSymbolVal Proxy ('Just s)
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
instance KnownMaybeSymbol 'Nothing where
  maybeSymbolVal :: Proxy 'Nothing -> Maybe Text
maybeSymbolVal Proxy 'Nothing
_ = Maybe Text
forall a. Maybe a
Nothing

type family IsSub (sname :: Symbol) (sub :: Maybe Symbol) :: Bool where
  IsSub sname 'Nothing      = 'False
  IsSub sname ('Just sname) = 'True
  IsSub sname ('Just other) = 'False

class IntrospectServices (ss :: [Service']) (sub :: Maybe Symbol) where
  introspectServices
    :: Proxy ss -> Proxy sub -> Writer TypeMap ()
instance IntrospectServices '[] sub where
  introspectServices :: Proxy '[] -> Proxy sub -> Writer TypeMap ()
introspectServices Proxy '[]
_ Proxy sub
_ = () -> Writer TypeMap ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance ( KnownSymbol sname
         , IntrospectFields smethods (IsSub sname sub)
         , IntrospectServices ss sub )
         => IntrospectServices ('Service sname smethods ': ss) sub where
  introspectServices :: Proxy ('Service sname smethods : ss)
-> Proxy sub -> Writer TypeMap ()
introspectServices Proxy ('Service sname smethods : ss)
_ Proxy sub
psub = do
    let name :: Text
name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sname -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sname
forall k (t :: k). Proxy t
Proxy @sname)
    [Field]
fs <- Proxy smethods -> Proxy (IsSub sname sub) -> Writer TypeMap [Field]
forall (fs :: [Method']) (isSub :: Bool).
IntrospectFields fs isSub =>
Proxy fs -> Proxy isSub -> Writer TypeMap [Field]
introspectFields (Proxy smethods
forall k (t :: k). Proxy t
Proxy @smethods) (Proxy (IsSub sname sub)
forall k (t :: k). Proxy t
Proxy @(IsSub sname sub))
    let t :: Type
t = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
OBJECT (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) [Field]
fs [] [] Maybe Type
forall a. Maybe a
Nothing
    -- add this one to the mix
    TypeMap -> Writer TypeMap ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Type -> TypeMap
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
name Type
t)
    -- continue with the rest
    Proxy ss -> Proxy sub -> Writer TypeMap ()
forall (ss :: [Service']) (sub :: Maybe Symbol).
IntrospectServices ss sub =>
Proxy ss -> Proxy sub -> Writer TypeMap ()
introspectServices (Proxy ss
forall k (t :: k). Proxy t
Proxy @ss) Proxy sub
psub

instance ( KnownSymbol sname, KnownSymbols elts
         , IntrospectServices ss sub )
         => IntrospectServices ('OneOf sname elts ': ss) sub where
  introspectServices :: Proxy ('OneOf sname elts : ss) -> Proxy sub -> Writer TypeMap ()
introspectServices Proxy ('OneOf sname elts : ss)
_ Proxy sub
psub = do
    let name :: Text
name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sname -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sname
forall k (t :: k). Proxy t
Proxy @sname)
        tys :: [Type]
tys  = (Text -> Type) -> [Text] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Type
tSimple (Proxy elts -> [Text]
forall (ss :: [Symbol]). KnownSymbols ss => Proxy ss -> [Text]
symbolsVal (Proxy elts
forall k (t :: k). Proxy t
Proxy @elts))
        t :: Type
t    = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
UNION (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) [] [] [Type]
tys Maybe Type
forall a. Maybe a
Nothing
    -- add this one to the mix
    TypeMap -> Writer TypeMap ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Type -> TypeMap
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
name Type
t)
    -- continue with the rest
    Proxy ss -> Proxy sub -> Writer TypeMap ()
forall (ss :: [Service']) (sub :: Maybe Symbol).
IntrospectServices ss sub =>
Proxy ss -> Proxy sub -> Writer TypeMap ()
introspectServices (Proxy ss
forall k (t :: k). Proxy t
Proxy @ss) Proxy sub
psub

class KnownSymbols (ss :: [Symbol]) where
  symbolsVal :: Proxy ss -> [T.Text]
instance KnownSymbols '[] where
  symbolsVal :: Proxy '[] -> [Text]
symbolsVal Proxy '[]
_ = []
instance (KnownSymbol s, KnownSymbols ss)
         => KnownSymbols (s ': ss) where
  symbolsVal :: Proxy (s : ss) -> [Text]
symbolsVal Proxy (s : ss)
_ = String -> Text
T.pack (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s)) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Proxy ss -> [Text]
forall (ss :: [Symbol]). KnownSymbols ss => Proxy ss -> [Text]
symbolsVal (Proxy ss
forall k (t :: k). Proxy t
Proxy @ss)

class IntrospectFields (fs :: [Method']) (isSub :: Bool) where
  introspectFields
    :: Proxy fs -> Proxy isSub -> Writer TypeMap [Field]
instance IntrospectFields '[] isSub where
  introspectFields :: Proxy '[] -> Proxy isSub -> Writer TypeMap [Field]
introspectFields Proxy '[]
_ Proxy isSub
_ = [Field] -> Writer TypeMap [Field]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ( KnownSymbol mname
         , IntrospectInputs margs
         , IntrospectReturn mret isSub
         , IntrospectFields fs isSub)
         => IntrospectFields ('Method mname margs mret ': fs) isSub where
  introspectFields :: Proxy ('Method mname margs mret : fs)
-> Proxy isSub -> Writer TypeMap [Field]
introspectFields Proxy ('Method mname margs mret : fs)
_ Proxy isSub
pIsSub = do
    let name :: Text
name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy mname -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy mname
forall k (t :: k). Proxy t
Proxy @mname)
    [Input]
inputs <- Proxy margs -> Writer TypeMap [Input]
forall (args :: [Argument']).
IntrospectInputs args =>
Proxy args -> Writer TypeMap [Input]
introspectInputs (Proxy margs
forall k (t :: k). Proxy t
Proxy @margs)
    Type
ret <- Proxy mret -> Proxy isSub -> Writer TypeMap Type
forall (r :: Return Symbol (TypeRef Symbol)) (isSub :: Bool).
IntrospectReturn r isSub =>
Proxy r -> Proxy isSub -> Writer TypeMap Type
introspectReturn (Proxy mret
forall k (t :: k). Proxy t
Proxy @mret) Proxy isSub
pIsSub
    let this :: Field
this = Text -> [Input] -> Type -> Field
Field Text
name [Input]
inputs Type
ret
    (Field
this Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
:) ([Field] -> [Field])
-> Writer TypeMap [Field] -> Writer TypeMap [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy fs -> Proxy isSub -> Writer TypeMap [Field]
forall (fs :: [Method']) (isSub :: Bool).
IntrospectFields fs isSub =>
Proxy fs -> Proxy isSub -> Writer TypeMap [Field]
introspectFields (Proxy fs
forall k (t :: k). Proxy t
Proxy @fs) Proxy isSub
pIsSub

class IntrospectInputs (args :: [Argument']) where
  introspectInputs
    :: Proxy args -> Writer TypeMap [Input]
instance IntrospectInputs '[] where
  introspectInputs :: Proxy '[] -> Writer TypeMap [Input]
introspectInputs Proxy '[]
_ = [Input] -> Writer TypeMap [Input]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ( KnownMaybeSymbol nm
         , IntrospectTypeRef r
         , IntrospectInputs args )
         => IntrospectInputs ('ArgSingle nm r ': args) where
  introspectInputs :: Proxy ('ArgSingle nm r : args) -> Writer TypeMap [Input]
introspectInputs Proxy ('ArgSingle nm r : args)
_ = do
    let nm :: Maybe Text
nm = Proxy nm -> Maybe Text
forall (s :: Maybe Symbol).
KnownMaybeSymbol s =>
Proxy s -> Maybe Text
maybeSymbolVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm)
    Type
t <- Proxy r -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy r
forall k (t :: k). Proxy t
Proxy @r) Bool
False
    -- TODO: Find default value
    let this :: Input
this = Text -> Maybe Text -> Type -> Input
Input (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"arg" Maybe Text
nm) Maybe Text
forall a. Maybe a
Nothing Type
t
    (Input
this Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:) ([Input] -> [Input])
-> Writer TypeMap [Input] -> Writer TypeMap [Input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy args -> Writer TypeMap [Input]
forall (args :: [Argument']).
IntrospectInputs args =>
Proxy args -> Writer TypeMap [Input]
introspectInputs (Proxy args
forall k (t :: k). Proxy t
Proxy @args)
instance ( KnownMaybeSymbol nm
         , IntrospectTypeRef r
         , IntrospectInputs args )
         => IntrospectInputs ('ArgStream nm r ': args) where
  introspectInputs :: Proxy ('ArgStream nm r : args) -> Writer TypeMap [Input]
introspectInputs Proxy ('ArgStream nm r : args)
_ = do
    let nm :: Maybe Text
nm = Proxy nm -> Maybe Text
forall (s :: Maybe Symbol).
KnownMaybeSymbol s =>
Proxy s -> Maybe Text
maybeSymbolVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm)
    Type
t <- Type -> Type
tList (Type -> Type) -> Writer TypeMap Type -> Writer TypeMap Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy r -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy r
forall k (t :: k). Proxy t
Proxy @r) Bool
False
    -- TODO: Find default value
    let this :: Input
this = Text -> Maybe Text -> Type -> Input
Input (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"arg" Maybe Text
nm) Maybe Text
forall a. Maybe a
Nothing Type
t
    (Input
this Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:) ([Input] -> [Input])
-> Writer TypeMap [Input] -> Writer TypeMap [Input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy args -> Writer TypeMap [Input]
forall (args :: [Argument']).
IntrospectInputs args =>
Proxy args -> Writer TypeMap [Input]
introspectInputs (Proxy args
forall k (t :: k). Proxy t
Proxy @args)

class IntrospectReturn (r :: Return Symbol (TypeRef Symbol)) (isSub :: Bool) where
  introspectReturn
    :: Proxy r -> Proxy isSub -> Writer TypeMap Type

instance IntrospectReturn 'RetNothing isSub where
  introspectReturn :: Proxy 'RetNothing -> Proxy isSub -> Writer TypeMap Type
introspectReturn Proxy 'RetNothing
_ Proxy isSub
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Null"
instance IntrospectTypeRef t
         => IntrospectReturn ('RetSingle t) isSub where
  introspectReturn :: Proxy ('RetSingle t) -> Proxy isSub -> Writer TypeMap Type
introspectReturn Proxy ('RetSingle t)
_ Proxy isSub
_ = Proxy t -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy t
forall k (t :: k). Proxy t
Proxy @t) Bool
True
instance IntrospectTypeRef t
         => IntrospectReturn ('RetStream t) 'False where
  introspectReturn :: Proxy ('RetStream t) -> Proxy 'False -> Writer TypeMap Type
introspectReturn Proxy ('RetStream t)
_ Proxy 'False
_ = Type -> Type
tList (Type -> Type) -> Writer TypeMap Type -> Writer TypeMap Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy t -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy t
forall k (t :: k). Proxy t
Proxy @t) Bool
True
instance IntrospectTypeRef t
         => IntrospectReturn ('RetStream t) 'True where
  introspectReturn :: Proxy ('RetStream t) -> Proxy 'True -> Writer TypeMap Type
introspectReturn Proxy ('RetStream t)
_ Proxy 'True
_ = Proxy t -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy t
forall k (t :: k). Proxy t
Proxy @t) Bool
True

class IntrospectTypeRef (tr :: TypeRef Symbol) where
  introspectTypeRef
    :: Proxy tr -> Bool -> Writer TypeMap Type

instance IntrospectTypeRef ('PrimitiveRef Bool) where
  introspectTypeRef :: Proxy ('PrimitiveRef Bool) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Bool)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Boolean"
instance IntrospectTypeRef ('PrimitiveRef Int32) where
  introspectTypeRef :: Proxy ('PrimitiveRef Int32) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Int32)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Int"
instance IntrospectTypeRef ('PrimitiveRef Integer) where
  introspectTypeRef :: Proxy ('PrimitiveRef Integer) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Integer)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Int"
instance IntrospectTypeRef ('PrimitiveRef Double) where
  introspectTypeRef :: Proxy ('PrimitiveRef Double) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Double)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Float"
instance IntrospectTypeRef ('PrimitiveRef String) where
  introspectTypeRef :: Proxy ('PrimitiveRef String) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef String)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"String"
instance IntrospectTypeRef ('PrimitiveRef T.Text) where
  introspectTypeRef :: Proxy ('PrimitiveRef Text) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Text)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"String"
instance IntrospectTypeRef ('PrimitiveRef JSON.Value) where
  introspectTypeRef :: Proxy ('PrimitiveRef Value) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Value)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"JSON"
instance IntrospectTypeRef ('PrimitiveRef JSON.Object) where
  introspectTypeRef :: Proxy ('PrimitiveRef Object) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('PrimitiveRef Object)
_ Bool
_ = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"JSONObject"

instance (IntrospectTypeRef r)
         => IntrospectTypeRef ('ListRef r) where
  introspectTypeRef :: Proxy ('ListRef r) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('ListRef r)
_ Bool
isRet = Type -> Type
tList (Type -> Type) -> Writer TypeMap Type -> Writer TypeMap Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy r -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy r
forall k (t :: k). Proxy t
Proxy @r) Bool
isRet
instance (IntrospectTypeRef r)
         => IntrospectTypeRef ('OptionalRef r) where
  introspectTypeRef :: Proxy ('OptionalRef r) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('OptionalRef r)
_ Bool
isRet = do
    Type
r <- Proxy r -> Bool -> Writer TypeMap Type
forall (tr :: TypeRef Symbol).
IntrospectTypeRef tr =>
Proxy tr -> Bool -> Writer TypeMap Type
introspectTypeRef (Proxy r
forall k (t :: k). Proxy t
Proxy @r) Bool
isRet
    Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
r (Type -> Maybe Type
unwrapNonNull Type
r)

instance (KnownSymbol o)
         => IntrospectTypeRef ('ObjectRef o) where
  introspectTypeRef :: Proxy ('ObjectRef o) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('ObjectRef o)
_ Bool
_
    = Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
TypeRef (Text -> Type) -> Text -> Type
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy o -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy o
forall k (t :: k). Proxy t
Proxy @o)

instance (IntrospectSchema sch, KnownSymbol t)
         => IntrospectTypeRef ('SchemaRef sch t) where
  introspectTypeRef :: Proxy ('SchemaRef sch t) -> Bool -> Writer TypeMap Type
introspectTypeRef Proxy ('SchemaRef sch t)
_ Bool
isRet = do
    let (TypeKind
k, Text
suffix) = if Bool
isRet then (TypeKind
OBJECT, Text
"R") else (TypeKind
INPUT_OBJECT, Text
"")
    TypeKind -> Text -> Proxy sch -> Writer TypeMap ()
forall (ts :: [TypeDef Symbol Symbol]).
IntrospectSchema ts =>
TypeKind -> Text -> Proxy ts -> Writer TypeMap ()
introspectSchema TypeKind
k Text
suffix (Proxy sch
forall k (t :: k). Proxy t
Proxy @sch)
    Type -> Writer TypeMap Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
TypeRef (Text -> Type) -> Text -> Type
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Proxy t -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix

class IntrospectSchema (ts :: [Mu.TypeDef Symbol Symbol]) where
  introspectSchema
    :: TypeKind -> T.Text -> Proxy ts -> Writer TypeMap ()
instance IntrospectSchema '[] where
  introspectSchema :: TypeKind -> Text -> Proxy '[] -> Writer TypeMap ()
introspectSchema TypeKind
_ Text
_ Proxy '[]
_ = () -> Writer TypeMap ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (KnownSymbol name, IntrospectSchemaFields fields, IntrospectSchema ts)
         => IntrospectSchema ('Mu.DRecord name fields ': ts) where
  introspectSchema :: TypeKind
-> Text -> Proxy ('DRecord name fields : ts) -> Writer TypeMap ()
introspectSchema TypeKind
k Text
suffix Proxy ('DRecord name fields : ts)
_ = do
    let name :: Text
name = String -> Text
T.pack (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
        fs :: [Field]
fs   = Text -> Proxy fields -> [Field]
forall (fs :: [FieldDef Symbol Symbol]).
IntrospectSchemaFields fs =>
Text -> Proxy fs -> [Field]
introspectSchemaFields Text
suffix (Proxy fields
forall k (t :: k). Proxy t
Proxy @fields)
        t :: Type
t    = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
k (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) [Field]
fs [] [] Maybe Type
forall a. Maybe a
Nothing
    -- add this one to the mix
    TypeMap -> Writer TypeMap ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Type -> TypeMap
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
name Type
t)
    -- continue with the rest
    TypeKind -> Text -> Proxy ts -> Writer TypeMap ()
forall (ts :: [TypeDef Symbol Symbol]).
IntrospectSchema ts =>
TypeKind -> Text -> Proxy ts -> Writer TypeMap ()
introspectSchema TypeKind
k Text
suffix (Proxy ts
forall k (t :: k). Proxy t
Proxy @ts)
instance (KnownSymbol name, IntrospectSchemaEnum choices, IntrospectSchema ts)
         => IntrospectSchema ('Mu.DEnum name choices ': ts) where
  introspectSchema :: TypeKind
-> Text -> Proxy ('DEnum name choices : ts) -> Writer TypeMap ()
introspectSchema TypeKind
k Text
suffix Proxy ('DEnum name choices : ts)
_ = do
    let name :: Text
name = String -> Text
T.pack (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
        cs :: [EnumValue]
cs   = Proxy choices -> [EnumValue]
forall (c :: [ChoiceDef Symbol]).
IntrospectSchemaEnum c =>
Proxy c -> [EnumValue]
introspectSchemaEnum (Proxy choices
forall k (t :: k). Proxy t
Proxy @choices)
        t :: Type
t    = TypeKind
-> Maybe Text
-> [Field]
-> [EnumValue]
-> [Type]
-> Maybe Type
-> Type
Type TypeKind
ENUM (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) [] [EnumValue]
cs [] Maybe Type
forall a. Maybe a
Nothing
    -- add this one to the mix
    TypeMap -> Writer TypeMap ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Type -> TypeMap
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
name Type
t)
    -- continue with the rest
    TypeKind -> Text -> Proxy ts -> Writer TypeMap ()
forall (ts :: [TypeDef Symbol Symbol]).
IntrospectSchema ts =>
TypeKind -> Text -> Proxy ts -> Writer TypeMap ()
introspectSchema TypeKind
k Text
suffix (Proxy ts
forall k (t :: k). Proxy t
Proxy @ts)

class IntrospectSchemaFields (fs :: [Mu.FieldDef Symbol Symbol]) where
  introspectSchemaFields
    :: T.Text -> Proxy fs -> [Field]
instance IntrospectSchemaFields '[] where
  introspectSchemaFields :: Text -> Proxy '[] -> [Field]
introspectSchemaFields Text
_ Proxy '[]
_ = []
instance (KnownSymbol fname,IntrospectSchemaFieldType r, IntrospectSchemaFields fs)
         => IntrospectSchemaFields ('Mu.FieldDef fname r ': fs) where
  introspectSchemaFields :: Text -> Proxy ('FieldDef fname r : fs) -> [Field]
introspectSchemaFields Text
suffix Proxy ('FieldDef fname r : fs)
_
    = let name :: Text
name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy fname -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy fname
forall k (t :: k). Proxy t
Proxy @fname)
          ret :: Type
ret  = Text -> Proxy r -> Type
forall (t :: FieldType Symbol).
IntrospectSchemaFieldType t =>
Text -> Proxy t -> Type
introspectSchemaFieldType Text
suffix (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
          this :: Field
this = Text -> [Input] -> Type -> Field
Field Text
name [] Type
ret
      in Field
this Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: Text -> Proxy fs -> [Field]
forall (fs :: [FieldDef Symbol Symbol]).
IntrospectSchemaFields fs =>
Text -> Proxy fs -> [Field]
introspectSchemaFields Text
suffix (Proxy fs
forall k (t :: k). Proxy t
Proxy @fs)

class IntrospectSchemaFieldType (t :: Mu.FieldType Symbol) where
  introspectSchemaFieldType
    :: T.Text -> Proxy t -> Type

instance IntrospectSchemaFieldType ('Mu.TPrimitive Bool) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Bool) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Bool)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Boolean"
instance IntrospectSchemaFieldType ('Mu.TPrimitive Int32) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Int32) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Int32)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Int"
instance IntrospectSchemaFieldType ('Mu.TPrimitive Integer) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Integer) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Integer)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Int"
instance IntrospectSchemaFieldType ('Mu.TPrimitive Double) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Double) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Double)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"Float"
instance IntrospectSchemaFieldType ('Mu.TPrimitive String) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive String) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive String)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"String"
instance IntrospectSchemaFieldType ('Mu.TPrimitive T.Text) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Text) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Text)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"String"
instance IntrospectSchemaFieldType ('Mu.TPrimitive JSON.Value) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Value) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Value)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"JSON"
instance IntrospectSchemaFieldType ('Mu.TPrimitive JSON.Object) where
  introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Object) -> Type
introspectSchemaFieldType Text
_ Proxy ('TPrimitive Object)
_ = Type -> Type
tNonNull (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Type
tSimple Text
"JSONObject"

instance (IntrospectSchemaFieldType r)
         => IntrospectSchemaFieldType ('Mu.TList r) where
  introspectSchemaFieldType :: Text -> Proxy ('TList r) -> Type
introspectSchemaFieldType Text
suffix Proxy ('TList r)
_
    = Type -> Type
tList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Proxy r -> Type
forall (t :: FieldType Symbol).
IntrospectSchemaFieldType t =>
Text -> Proxy t -> Type
introspectSchemaFieldType Text
suffix (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
instance (IntrospectSchemaFieldType r)
         => IntrospectSchemaFieldType ('Mu.TOption r) where
  introspectSchemaFieldType :: Text -> Proxy ('TOption r) -> Type
introspectSchemaFieldType Text
suffix Proxy ('TOption r)
_
    = let r :: Type
r = Text -> Proxy r -> Type
forall (t :: FieldType Symbol).
IntrospectSchemaFieldType t =>
Text -> Proxy t -> Type
introspectSchemaFieldType Text
suffix (Proxy r
forall k (t :: k). Proxy t
Proxy @r)
      in Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
r (Type -> Maybe Type
unwrapNonNull Type
r)

instance (KnownSymbol nm)
         => IntrospectSchemaFieldType ('Mu.TSchematic nm) where
  introspectSchemaFieldType :: Text -> Proxy ('TSchematic nm) -> Type
introspectSchemaFieldType Text
suffix Proxy ('TSchematic nm)
_
    = Text -> Type
TypeRef (Text -> Type) -> Text -> Type
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Proxy nm -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix

class IntrospectSchemaEnum (c :: [Mu.ChoiceDef Symbol]) where
  introspectSchemaEnum :: Proxy c -> [EnumValue]
instance IntrospectSchemaEnum '[] where
  introspectSchemaEnum :: Proxy '[] -> [EnumValue]
introspectSchemaEnum Proxy '[]
_ = []
instance (KnownSymbol nm, IntrospectSchemaEnum cs)
         => IntrospectSchemaEnum ('Mu.ChoiceDef nm ': cs) where
  introspectSchemaEnum :: Proxy ('ChoiceDef nm : cs) -> [EnumValue]
introspectSchemaEnum Proxy ('ChoiceDef nm : cs)
_
    = let this :: EnumValue
this = Text -> EnumValue
EnumValue (Text -> EnumValue) -> Text -> EnumValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy nm -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm)
      in EnumValue
this EnumValue -> [EnumValue] -> [EnumValue]
forall a. a -> [a] -> [a]
: Proxy cs -> [EnumValue]
forall (c :: [ChoiceDef Symbol]).
IntrospectSchemaEnum c =>
Proxy c -> [EnumValue]
introspectSchemaEnum (Proxy cs
forall k (t :: k). Proxy t
Proxy @cs)