higherkindness/mu-haskell
1
1
Fork 0
mirror of https://github.com/higherkindness/mu-haskell.git synced 2024-08-17 02:10:22 +03:00
Code Issues Projects Releases Wiki Activity

Fixes #342

Browse Source
This commit is contained in:
Alejandro Serrano 2023-01-07 21:38:41 +01:00
parent 517d5dd5e7
commit 3d0a80e374
3 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
adapter/protobuf/src/Mu/Quasi/GRpc.hs
View File

@ -18,8 +18,6 @@ import GHC.TypeLits
import Language.Haskell.TH import Language.Haskell.TH
import Language.ProtocolBuffers.Parser import Language.ProtocolBuffers.Parser
import qualified Language.ProtocolBuffers.Types as P import qualified Language.ProtocolBuffers.Types as P
import Network.HTTP.Client
import Servant.Client.Core.BaseUrl
import Mu.Quasi.ProtoBuf import Mu.Quasi.ProtoBuf
import Mu.Rpc import Mu.Rpc

2
graphql/mu-graphql.cabal
View File

@ -1,5 +1,5 @@
name: mu-graphql name: mu-graphql
version: 0.5.0.3 version: 0.5.0.4
synopsis: GraphQL support for Mu synopsis: GraphQL support for Mu
description: GraphQL servers and clients for Mu-Haskell description: GraphQL servers and clients for Mu-Haskell
cabal-version: >=1.10 cabal-version: >=1.10

11
graphql/src/Mu/GraphQL/Query/Introspection.hs
View File

@ -18,6 +18,7 @@ import Data.Int (Int32)
import Data.Maybe (catMaybes, fromMaybe) import Data.Maybe (catMaybes, fromMaybe)
import Data.Proxy import Data.Proxy
import qualified Data.Text as T import qualified Data.Text as T
import Data.UUID (UUID)
import GHC.TypeLits import GHC.TypeLits
import Mu.Rpc import Mu.Rpc
import qualified Mu.Schema as Mu import qualified Mu.Schema as Mu
@ -67,7 +68,7 @@ data TypeKind
= SCALAR = SCALAR
| OBJECT | OBJECT
| INTERFACE | INTERFACE
| UNION | UNION
| ENUM | ENUM
| INPUT_OBJECT | INPUT_OBJECT
| LIST | LIST
@ -75,13 +76,13 @@ data TypeKind
deriving Show deriving Show
tSimple :: T.Text -> Type tSimple :: T.Text -> Type
tSimple t = Type SCALAR (Just t) [] [] [] Nothing tSimple t = Type SCALAR (Just t) [] [] [] Nothing
tList :: Type -> Type tList :: Type -> Type
tList = Type LIST Nothing [] [] [] . Just tList = Type LIST Nothing [] [] [] . Just
tNonNull :: Type -> Type tNonNull :: Type -> Type
tNonNull = Type NON_NULL Nothing [] [] [] . Just tNonNull = Type NON_NULL Nothing [] [] [] . Just
unwrapNonNull :: Type -> Maybe Type unwrapNonNull :: Type -> Maybe Type
unwrapNonNull (Type NON_NULL _ _ _ _ x) = x unwrapNonNull (Type NON_NULL _ _ _ _ x) = x
@ -188,7 +189,7 @@ instance ( KnownSymbol sname, KnownSymbols elts
introspectServices _ psub = do introspectServices _ psub = do
let name = T.pack $ symbolVal (Proxy @sname) let name = T.pack $ symbolVal (Proxy @sname)
tys = map tSimple (symbolsVal (Proxy @elts)) tys = map tSimple (symbolsVal (Proxy @elts))
t = Type UNION (Just name) [] [] tys Nothing t = Type UNION (Just name) [] [] tys Nothing
-- add this one to the mix -- add this one to the mix
tell (HM.singleton name t) tell (HM.singleton name t)
-- continue with the rest -- continue with the rest
@ -281,6 +282,8 @@ instance IntrospectTypeRef ('PrimitiveRef JSON.Value) where
introspectTypeRef _ _ = pure $ tNonNull $ tSimple "JSON" introspectTypeRef _ _ = pure $ tNonNull $ tSimple "JSON"
instance IntrospectTypeRef ('PrimitiveRef JSON.Object) where instance IntrospectTypeRef ('PrimitiveRef JSON.Object) where
introspectTypeRef _ _ = pure $ tNonNull $ tSimple "JSONObject" introspectTypeRef _ _ = pure $ tNonNull $ tSimple "JSONObject"
instance IntrospectTypeRef ('PrimitiveRef UUID) where
introspectTypeRef _ _ = pure $ tNonNull $ tSimple "UUID"
instance (IntrospectTypeRef r) instance (IntrospectTypeRef r)
=> IntrospectTypeRef ('ListRef r) where => IntrospectTypeRef ('ListRef r) where