mirror of
https://github.com/higherkindness/mu-haskell.git
synced 2024-08-17 02:10:22 +03:00
Fixes #342
This commit is contained in:
parent
517d5dd5e7
commit
3d0a80e374
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user