diff --git a/wip/haddock/mu-avro/mu-avro.haddock b/wip/haddock/mu-avro/mu-avro.haddock index 36d6836..4e02d03 100644 Binary files a/wip/haddock/mu-avro/mu-avro.haddock and b/wip/haddock/mu-avro/mu-avro.haddock differ diff --git a/wip/haddock/mu-graphql/mu-graphql.haddock b/wip/haddock/mu-graphql/mu-graphql.haddock index 34a8df9..f974fe3 100644 Binary files a/wip/haddock/mu-graphql/mu-graphql.haddock and b/wip/haddock/mu-graphql/mu-graphql.haddock differ diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Annotations.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Annotations.html index fffe054..616acc7 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Annotations.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Annotations.html @@ -38,24 +38,24 @@ to provide this additional information. -- | Type-level GraphQL constant values. -- Due to limitations in type-level literal values -- floating point constants cannot be represented. -data ValueConst nat symbol - = VCInt nat -- ^ Integer. - | VCString symbol -- ^ String. +data ValueConst nat symbol + = VCInt nat -- ^ Integer. + | VCString symbol -- ^ String. | VCBoolean Bool -- ^ Boolean. | VCNull -- ^ Null. - | VCEnum symbol -- ^ Enumeration value. - | VCList [ValueConst nat symbol] -- ^ List of constant values. - | VCObject [(symbol, ValueConst nat symbol)] + | VCEnum symbol -- ^ Enumeration value. + | VCList [ValueConst nat symbol] -- ^ List of constant values. + | VCObject [(symbol, ValueConst nat symbol)] -- ^ Object represented by (key, value) tuples. -- | Turn a 'GQL.ValueConst' coming from parsing -- in the annotation data type. Mostly used -- internally to generate Mu schemas from GraphQL schemas. -fromGQLValueConst :: forall f. Alternative f - => GQL.ConstValue -> f (ValueConst Integer String) +fromGQLValueConst :: forall f. Alternative f + => GQL.ConstValue -> f (ValueConst Integer String) fromGQLValueConst :: ConstValue -> f (ValueConst Integer String) -fromGQLValueConst (GQL.ConstInt Int32 -n) +fromGQLValueConst (GQL.ConstInt Int32 +n) = ValueConst Integer String -> f (ValueConst Integer String) forall (f :: * -> *) a. Applicative f => a -> f a pure (ValueConst Integer String -> f (ValueConst Integer String)) @@ -66,9 +66,9 @@ forall nat symbol. nat -> ValueConst nat symbol VCInt (Int32 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Int32 -n) -fromGQLValueConst (GQL.ConstString Text -s) +n) +fromGQLValueConst (GQL.ConstString Text +s) = ValueConst Integer String -> f (ValueConst Integer String) forall (f :: * -> *) a. Applicative f => a -> f a pure (ValueConst Integer String -> f (ValueConst Integer String)) @@ -81,9 +81,9 @@ forall nat symbol. symbol -> ValueConst nat symbol forall a b. (a -> b) -> a -> b $ Text -> String T.unpack Text -s -fromGQLValueConst (GQL.ConstBoolean Bool -b) +s +fromGQLValueConst (GQL.ConstBoolean Bool +b) = ValueConst Integer String -> f (ValueConst Integer String) forall (f :: * -> *) a. Applicative f => a -> f a pure (ValueConst Integer String -> f (ValueConst Integer String)) @@ -92,7 +92,7 @@ forall a b. (a -> b) -> a -> b $ Bool -> ValueConst Integer String forall nat symbol. Bool -> ValueConst nat symbol VCBoolean Bool -b +b fromGQLValueConst ConstValue GQL.ConstNull = ValueConst Integer String -> f (ValueConst Integer String) @@ -100,8 +100,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure ValueConst Integer String forall nat symbol. ValueConst nat symbol VCNull -fromGQLValueConst (GQL.ConstEnum Text -s) +fromGQLValueConst (GQL.ConstEnum Text +s) = ValueConst Integer String -> f (ValueConst Integer String) forall (f :: * -> *) a. Applicative f => a -> f a pure (ValueConst Integer String -> f (ValueConst Integer String)) @@ -114,9 +114,9 @@ forall nat symbol. symbol -> ValueConst nat symbol forall a b. (a -> b) -> a -> b $ Text -> String T.unpack Text -s -fromGQLValueConst (GQL.ConstList [Node ConstValue] -xs) +s +fromGQLValueConst (GQL.ConstList [Node ConstValue] +xs) = [ValueConst Integer String] -> ValueConst Integer String forall nat symbol. [ValueConst nat symbol] -> ValueConst nat symbol VCList ([ValueConst Integer String] -> ValueConst Integer String) @@ -139,9 +139,9 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c . Node ConstValue -> ConstValue forall a. Node a -> a GQL.node) [Node ConstValue] -xs -fromGQLValueConst (GQL.ConstObject [ObjectField ConstValue] -o) +xs +fromGQLValueConst (GQL.ConstObject [ObjectField ConstValue] +o) = [(String, ValueConst Integer String)] -> ValueConst Integer String forall nat symbol. [(symbol, ValueConst nat symbol)] -> ValueConst nat symbol @@ -157,19 +157,19 @@ forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ObjectField ConstValue -> f (String, ValueConst Integer String) -fromGQLField [ObjectField ConstValue] -o - where fromGQLField :: GQL.ObjectField GQL.ConstValue - -> f (String, ValueConst Integer String) - fromGQLField :: ObjectField ConstValue -> f (String, ValueConst Integer String) -fromGQLField (GQL.ObjectField Text -n (GQL.Node ConstValue -v Location +fromGQLField [ObjectField ConstValue] +o + where fromGQLField :: GQL.ObjectField GQL.ConstValue + -> f (String, ValueConst Integer String) + fromGQLField :: ObjectField ConstValue -> f (String, ValueConst Integer String) +fromGQLField (GQL.ObjectField Text +n (GQL.Node ConstValue +v Location _) Location _) = (Text -> String T.unpack Text -n,) (ValueConst Integer String -> (String, ValueConst Integer String)) +n,) (ValueConst Integer String -> (String, ValueConst Integer String)) -> f (ValueConst Integer String) -> f (String, ValueConst Integer String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -178,7 +178,7 @@ forall (f :: * -> *). Alternative f => ConstValue -> f (ValueConst Integer String) fromGQLValueConst ConstValue -v +v fromGQLValueConst ConstValue _ = f (ValueConst Integer String) forall (f :: * -> *) a. Alternative f => f a @@ -188,13 +188,13 @@ forall (f :: * -> *) a. Alternative f => f a -- to a type-level constant. Inhabited by any -- 'ValueConst', but still required to please -- the type checker. -class ReflectValueConst (v :: ValueConst nat symbol) where +class ReflectValueConst (v :: ValueConst nat symbol) where -- | Obtain the GraphQL constant corresponding -- to a type-level constant. - reflectValueConst :: proxy v -> GQL.ConstValue -instance KnownNat n => ReflectValueConst ('VCInt n) where - reflectValueConst :: proxy ('VCInt n) -> ConstValue -reflectValueConst proxy ('VCInt n) + reflectValueConst :: proxy v -> GQL.ConstValue +instance KnownNat n => ReflectValueConst ('VCInt n) where + reflectValueConst :: proxy ('VCInt n) -> ConstValue +reflectValueConst proxy ('VCInt n) _ = Int32 -> ConstValue GQL.ConstInt (Int32 -> ConstValue) -> Int32 -> ConstValue forall a b. (a -> b) -> a -> b @@ -208,10 +208,10 @@ KnownNat n => proxy n -> Integer natVal (Proxy n forall k (t :: k). Proxy t -Proxy @n) -instance KnownSymbol s => ReflectValueConst ('VCString s) where - reflectValueConst :: proxy ('VCString s) -> ConstValue -reflectValueConst proxy ('VCString s) +Proxy @n) +instance KnownSymbol s => ReflectValueConst ('VCString s) where + reflectValueConst :: proxy ('VCString s) -> ConstValue +reflectValueConst proxy ('VCString s) _ = Text -> ConstValue GQL.ConstString (Text -> ConstValue) -> Text -> ConstValue forall a b. (a -> b) -> a -> b @@ -224,27 +224,27 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy s forall k (t :: k). Proxy t -Proxy @s) +Proxy @s) instance ReflectValueConst ('VCBoolean 'True) where - reflectValueConst :: proxy ('VCBoolean 'True) -> ConstValue -reflectValueConst proxy ('VCBoolean 'True) + reflectValueConst :: proxy ('VCBoolean 'True) -> ConstValue +reflectValueConst proxy ('VCBoolean 'True) _ = Bool -> ConstValue GQL.ConstBoolean Bool True instance ReflectValueConst ('VCBoolean 'False) where - reflectValueConst :: proxy ('VCBoolean 'False) -> ConstValue -reflectValueConst proxy ('VCBoolean 'False) + reflectValueConst :: proxy ('VCBoolean 'False) -> ConstValue +reflectValueConst proxy ('VCBoolean 'False) _ = Bool -> ConstValue GQL.ConstBoolean Bool False instance ReflectValueConst 'VCNull where - reflectValueConst :: proxy 'VCNull -> ConstValue -reflectValueConst proxy 'VCNull + reflectValueConst :: proxy 'VCNull -> ConstValue +reflectValueConst proxy 'VCNull _ = ConstValue GQL.ConstNull -instance KnownSymbol e => ReflectValueConst ('VCEnum e) where - reflectValueConst :: proxy ('VCEnum e) -> ConstValue -reflectValueConst proxy ('VCEnum e) +instance KnownSymbol e => ReflectValueConst ('VCEnum e) where + reflectValueConst :: proxy ('VCEnum e) -> ConstValue +reflectValueConst proxy ('VCEnum e) _ = Text -> ConstValue GQL.ConstString (Text -> ConstValue) -> Text -> ConstValue forall a b. (a -> b) -> a -> b @@ -257,10 +257,10 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy e forall k (t :: k). Proxy t -Proxy @e) -instance ReflectValueConstList xs => ReflectValueConst ('VCList xs) where - reflectValueConst :: proxy ('VCList xs) -> ConstValue -reflectValueConst proxy ('VCList xs) +Proxy @e) +instance ReflectValueConstList xs => ReflectValueConst ('VCList xs) where + reflectValueConst :: proxy ('VCList xs) -> ConstValue +reflectValueConst proxy ('VCList xs) _ = [Node ConstValue] -> ConstValue GQL.ConstList ([Node ConstValue] -> ConstValue) -> [Node ConstValue] -> ConstValue @@ -283,10 +283,10 @@ ReflectValueConstList xs => proxy xs -> [ConstValue] reflectValueConstList (Proxy xs forall k (t :: k). Proxy t -Proxy @xs) -instance ReflectValueConstObject xs => ReflectValueConst ('VCObject xs) where - reflectValueConst :: proxy ('VCObject xs) -> ConstValue -reflectValueConst proxy ('VCObject xs) +Proxy @xs) +instance ReflectValueConstObject xs => ReflectValueConst ('VCObject xs) where + reflectValueConst :: proxy ('VCObject xs) -> ConstValue +reflectValueConst proxy ('VCObject xs) _ = [ObjectField ConstValue] -> ConstValue GQL.ConstObject ([ObjectField ConstValue] -> ConstValue) -> [ObjectField ConstValue] -> ConstValue @@ -297,18 +297,18 @@ ReflectValueConstObject xs => proxy xs -> [ObjectField ConstValue] reflectValueConstObject (Proxy xs forall k (t :: k). Proxy t -Proxy @xs) +Proxy @xs) -class ReflectValueConstList xs where - reflectValueConstList :: proxy xs -> [GQL.ConstValue] +class ReflectValueConstList xs where + reflectValueConstList :: proxy xs -> [GQL.ConstValue] instance ReflectValueConstList '[] where - reflectValueConstList :: proxy '[] -> [ConstValue] -reflectValueConstList proxy '[] + reflectValueConstList :: proxy '[] -> [ConstValue] +reflectValueConstList proxy '[] _ = [] -instance (ReflectValueConst x, ReflectValueConstList xs) - => ReflectValueConstList (x ': xs) where - reflectValueConstList :: proxy (x : xs) -> [ConstValue] -reflectValueConstList proxy (x : xs) +instance (ReflectValueConst x, ReflectValueConstList xs) + => ReflectValueConstList (x ': xs) where + reflectValueConstList :: proxy (x : xs) -> [ConstValue] +reflectValueConstList proxy (x : xs) _ = Proxy x -> ConstValue forall nat symbol (v :: ValueConst nat symbol) @@ -317,7 +317,7 @@ ReflectValueConst v => proxy v -> ConstValue reflectValueConst (Proxy x forall k (t :: k). Proxy t -Proxy @x) ConstValue -> [ConstValue] -> [ConstValue] +Proxy @x) ConstValue -> [ConstValue] -> [ConstValue] forall a. a -> [a] -> [a] : Proxy xs -> [ConstValue] forall k (xs :: k) (proxy :: k -> *). @@ -325,18 +325,18 @@ ReflectValueConstList xs => proxy xs -> [ConstValue] reflectValueConstList (Proxy xs forall k (t :: k). Proxy t -Proxy @xs) +Proxy @xs) -class ReflectValueConstObject xs where - reflectValueConstObject :: proxy xs -> [GQL.ObjectField GQL.ConstValue] +class ReflectValueConstObject xs where + reflectValueConstObject :: proxy xs -> [GQL.ObjectField GQL.ConstValue] instance ReflectValueConstObject '[] where - reflectValueConstObject :: proxy '[] -> [ObjectField ConstValue] -reflectValueConstObject proxy '[] + reflectValueConstObject :: proxy '[] -> [ObjectField ConstValue] +reflectValueConstObject proxy '[] _ = [] -instance (KnownSymbol a, ReflectValueConst x, ReflectValueConstObject xs) - => ReflectValueConstObject ( '(a, x) ': xs) where - reflectValueConstObject :: proxy ('(a, x) : xs) -> [ObjectField ConstValue] -reflectValueConstObject proxy ('(a, x) : xs) +instance (KnownSymbol a, ReflectValueConst x, ReflectValueConstObject xs) + => ReflectValueConstObject ( '(a, x) ': xs) where + reflectValueConstObject :: proxy ('(a, x) : xs) -> [ObjectField ConstValue] +reflectValueConstObject proxy ('(a, x) : xs) _ = Text -> Node ConstValue -> Location -> ObjectField ConstValue forall a. Text -> Node a -> Location -> ObjectField a @@ -349,7 +349,7 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy a forall k (t :: k). Proxy t -Proxy @a)) +Proxy @a)) (ConstValue -> Location -> Node ConstValue forall a. a -> Location -> Node a GQL.Node (Proxy x -> ConstValue @@ -359,10 +359,10 @@ ReflectValueConst v => proxy v -> ConstValue reflectValueConst (Proxy x forall k (t :: k). Proxy t -Proxy @x)) Location -zl) +Proxy @x)) Location +zl) Location -zl +zl ObjectField ConstValue -> [ObjectField ConstValue] -> [ObjectField ConstValue] forall a. a -> [a] -> [a] @@ -372,9 +372,9 @@ ReflectValueConstObject xs => proxy xs -> [ObjectField ConstValue] reflectValueConstObject (Proxy xs forall k (t :: k). Proxy t -Proxy @xs) - where zl :: Location -zl = Word -> Word -> Location +Proxy @xs) + where zl :: Location +zl = Word -> Word -> Location GQL.Location Word 0 Word 0 diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.LostParser.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.LostParser.html index 206a806..1170d71 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.LostParser.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.LostParser.html @@ -12,8 +12,8 @@ parseDoc :: T.Text -> Either T.Text [GQL.Definition] parseDoc :: Text -> Either Text [Definition] -parseDoc Text -s = +parseDoc Text +s = case Parsec Void Text Document -> String -> Text -> Either (ParseErrorBundle Text Void) Document forall e s a. @@ -21,16 +21,16 @@ Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a runParser Parsec Void Text Document document String "<doc>" Text -s of - Right Document -d -> [Definition] -> Either Text [Definition] +s of + Right Document +d -> [Definition] -> Either Text [Definition] forall a b. b -> Either a b Right (Document -> [Definition] forall (t :: * -> *) a. Foldable t => t a -> [a] toList Document -d) - Left ParseErrorBundle Text Void -e -> Text -> Either Text [Definition] +d) + Left ParseErrorBundle Text Void +e -> Text -> Either Text [Definition] forall a b. a -> Either a b Left (String -> Text T.pack (String -> Text) -> String -> Text @@ -38,12 +38,12 @@ forall a b. (a -> b) -> a -> b $ ParseErrorBundle Text Void -> String forall a. Show a => a -> String show ParseErrorBundle Text Void -e) +e) parseTypeSysDefinition :: T.Text -> Either T.Text [GQL.TypeSystemDefinition] parseTypeSysDefinition :: Text -> Either Text [TypeSystemDefinition] -parseTypeSysDefinition Text -s = +parseTypeSysDefinition Text +s = case Parsec Void Text Document -> String -> Text -> Either (ParseErrorBundle Text Void) Document forall e s a. @@ -51,36 +51,36 @@ Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a runParser Parsec Void Text Document document String "<doc>" Text -s of +s of Right (Document -> [Definition] forall (t :: * -> *) a. Foldable t => t a -> [a] -toList -> [Definition] -d) - -> let tds :: [TypeSystemDefinition] -tds = [TypeSystemDefinition -td | GQL.TypeSystemDefinition TypeSystemDefinition -td Location +toList -> [Definition] +d) + -> let tds :: [TypeSystemDefinition] +tds = [TypeSystemDefinition +td | GQL.TypeSystemDefinition TypeSystemDefinition +td Location _ <- [Definition] -d] +d] in if [Definition] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Definition] -d Int -> Int -> Bool +d Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == [TypeSystemDefinition] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [TypeSystemDefinition] -tds +tds then [TypeSystemDefinition] -> Either Text [TypeSystemDefinition] forall a b. b -> Either a b Right [TypeSystemDefinition] -tds +tds else Text -> Either Text [TypeSystemDefinition] forall a b. a -> Either a b Left Text "unexpected query or type system extension" - Left ParseErrorBundle Text Void -e + Left ParseErrorBundle Text Void +e -> Text -> Either Text [TypeSystemDefinition] forall a b. a -> Either a b Left (String -> Text @@ -89,5 +89,5 @@ forall a b. (a -> b) -> a -> b $ ParseErrorBundle Text Void -> String forall a. Show a => a -> String show ParseErrorBundle Text Void -e) +e) \ No newline at end of file diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.html index bab77e9..1a7cc20 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Quasi.html @@ -38,14 +38,14 @@ and 'Package' with one 'Service' per object in the schema. -> FilePath -- ^ Route to the file -> Q [Dec] graphql :: String -> String -> Q [Dec] -graphql String -name = Primitives -> String -> String -> String -> Q [Dec] +graphql String +name = Primitives -> String -> String -> String -> Q [Dec] graphql' [] (String -name String -> String -> String +name String -> String -> String forall a. Semigroup a => a -> a -> a <> String "Schema") String -name +name -- | Imports an GraphQL schema definition from a file. graphqlWithExtendedPrimitives @@ -54,16 +54,16 @@ forall a. Semigroup a => a -> a -> a -> FilePath -- ^ Route to the file -> Q [Dec] graphqlWithExtendedPrimitives :: Primitives -> String -> String -> Q [Dec] -graphqlWithExtendedPrimitives Primitives -prims String -name = Primitives -> String -> String -> String -> Q [Dec] +graphqlWithExtendedPrimitives Primitives +prims String +name = Primitives -> String -> String -> String -> Q [Dec] graphql' Primitives -prims (String -name String -> String -> String +prims (String +name String -> String -> String forall a. Semigroup a => a -> a -> a <> String "Schema") String -name +name -- | Imports an GraphQL schema definition from a file. graphql' :: Primitives @@ -72,24 +72,24 @@ forall a. Semigroup a => a -> a -> a -> FilePath -- ^ Route to the file -> Q [Dec] graphql' :: Primitives -> String -> String -> String -> Q [Dec] -graphql' Primitives -prims String -scName String -svName String -file = do - Text -schema <- IO Text -> Q Text +graphql' Primitives +prims String +scName String +svName String +file = do + Text +schema <- IO Text -> Q Text forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Text -> Q Text) -> IO Text -> Q Text forall a b. (a -> b) -> a -> b $ String -> IO Text TIO.readFile String -file +file case Text -> Either Text [TypeSystemDefinition] parseTypeSysDefinition Text -schema of - Left Text -e -> String -> Q [Dec] +schema of + Left Text +e -> String -> Q [Dec] forall (m :: * -> *) a. MonadFail m => String -> m a fail (String "could not parse graphql spec: " String -> String -> String @@ -97,17 +97,17 @@ forall a. [a] -> [a] -> [a] ++ Text -> String forall a. Show a => a -> String show Text -e) - Right [TypeSystemDefinition] -p -> Primitives -> String -> String -> [TypeSystemDefinition] -> Q [Dec] +e) + Right [TypeSystemDefinition] +p -> Primitives -> String -> String -> [TypeSystemDefinition] -> Q [Dec] graphqlToDecls (Primitives basicPrimitives Primitives -> Primitives -> Primitives forall a. Semigroup a => a -> a -> a <> Primitives -prims) String -scName String -svName [TypeSystemDefinition] -p +prims) String +scName String +svName [TypeSystemDefinition] +p type Primitives = [(GQL.Name, TypeQ)] @@ -153,45 +153,45 @@ forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' SchemaMap -> TypeSystemDefinition -> SchemaMap -schemaToMap SchemaMap +schemaToMap SchemaMap forall k v. HashMap k v HM.empty where - schemaToMap :: SchemaMap -> GQL.TypeSystemDefinition -> SchemaMap - schemaToMap :: SchemaMap -> TypeSystemDefinition -> SchemaMap -schemaToMap SchemaMap -mp (GQL.SchemaDefinition [Directive] + schemaToMap :: SchemaMap -> GQL.TypeSystemDefinition -> SchemaMap + schemaToMap :: SchemaMap -> TypeSystemDefinition -> SchemaMap +schemaToMap SchemaMap +mp (GQL.SchemaDefinition [Directive] _ (NonEmpty OperationTypeDefinition -> [OperationTypeDefinition] forall (t :: * -> *) a. Foldable t => t a -> [a] -toList -> [OperationTypeDefinition] -ops)) = (SchemaMap -> OperationTypeDefinition -> SchemaMap) +toList -> [OperationTypeDefinition] +ops)) = (SchemaMap -> OperationTypeDefinition -> SchemaMap) -> SchemaMap -> [OperationTypeDefinition] -> SchemaMap forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' SchemaMap -> OperationTypeDefinition -> SchemaMap -operationToKeyValue SchemaMap -mp [OperationTypeDefinition] -ops - schemaToMap SchemaMap +operationToKeyValue SchemaMap +mp [OperationTypeDefinition] +ops + schemaToMap SchemaMap _ TypeSystemDefinition _ = String -> SchemaMap forall a. HasCallStack => String -> a error String "this should have been taken care by graphqlToDecls" - operationToKeyValue :: SchemaMap -> GQL.OperationTypeDefinition -> SchemaMap - operationToKeyValue :: SchemaMap -> OperationTypeDefinition -> SchemaMap -operationToKeyValue SchemaMap -mp (GQL.OperationTypeDefinition OperationType -opType Text -name) = Text -> OperationType -> SchemaMap -> SchemaMap + operationToKeyValue :: SchemaMap -> GQL.OperationTypeDefinition -> SchemaMap + operationToKeyValue :: SchemaMap -> OperationTypeDefinition -> SchemaMap +operationToKeyValue SchemaMap +mp (GQL.OperationTypeDefinition OperationType +opType Text +name) = Text -> OperationType -> SchemaMap -> SchemaMap forall k v. (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v HM.insert Text -name OperationType -opType SchemaMap -mp +name OperationType +opType SchemaMap +mp classify :: [GQL.TypeDefinition] -> TypeMap classify :: [TypeDefinition] -> TypeMap @@ -203,60 +203,60 @@ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v -> TypeMap forall b c a. (b -> c) -> (a -> b) -> a -> c . (TypeDefinition -> (Text, GQLType) -typeToKeyValue (TypeDefinition -> (Text, GQLType)) +typeToKeyValue (TypeDefinition -> (Text, GQLType)) -> [TypeDefinition] -> [(Text, GQLType)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) where - typeToKeyValue :: GQL.TypeDefinition -> (T.Text, GQLType) - typeToKeyValue :: TypeDefinition -> (Text, GQLType) -typeToKeyValue (GQL.ScalarTypeDefinition Description -_ Text -name [Directive] + typeToKeyValue :: GQL.TypeDefinition -> (T.Text, GQLType) + typeToKeyValue :: TypeDefinition -> (Text, GQLType) +typeToKeyValue (GQL.ScalarTypeDefinition Description +_ Text +name [Directive] _) = (Text -name, GQLType +name, GQLType Scalar) - typeToKeyValue (GQL.ObjectTypeDefinition Description -_ Text -name ImplementsInterfaces [] + typeToKeyValue (GQL.ObjectTypeDefinition Description +_ Text +name ImplementsInterfaces [] _ [Directive] _ [FieldDefinition] _) = (Text -name, GQLType +name, GQLType Object) - typeToKeyValue (GQL.InterfaceTypeDefinition Description -_ Text -name [Directive] + typeToKeyValue (GQL.InterfaceTypeDefinition Description +_ Text +name [Directive] _ [FieldDefinition] _) = (Text -name, GQLType +name, GQLType Interface) - typeToKeyValue (GQL.UnionTypeDefinition Description -_ Text -name [Directive] + typeToKeyValue (GQL.UnionTypeDefinition Description +_ Text +name [Directive] _ UnionMemberTypes [] _) = (Text -name, GQLType +name, GQLType Union) - typeToKeyValue (GQL.EnumTypeDefinition Description -_ Text -name [Directive] + typeToKeyValue (GQL.EnumTypeDefinition Description +_ Text +name [Directive] _ [EnumValueDefinition] _) = (Text -name, GQLType +name, GQLType Enum) - typeToKeyValue (GQL.InputObjectTypeDefinition Description -_ Text -name [Directive] + typeToKeyValue (GQL.InputObjectTypeDefinition Description +_ Text +name [Directive] _ [InputValueDefinition] _) = (Text -name, GQLType +name, GQLType InputObject) -- | Constructs the GraphQL tree splitting between Schemas and Services. @@ -265,112 +265,112 @@ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b -> String -> String -> [GQL.TypeSystemDefinition] -> Q [Dec] graphqlToDecls :: Primitives -> String -> String -> [TypeSystemDefinition] -> Q [Dec] -graphqlToDecls Primitives -prims String -schemaName String -serviceName [TypeSystemDefinition] -allTypes = do - let schemaName' :: Name -schemaName' = String -> Name +graphqlToDecls Primitives +prims String +schemaName String +serviceName [TypeSystemDefinition] +allTypes = do + let schemaName' :: Name +schemaName' = String -> Name mkName String -schemaName - serviceName' :: Name -serviceName' = String -> Name +schemaName + serviceName' :: Name +serviceName' = String -> Name mkName String -serviceName - types :: [TypeDefinition] -types = [TypeDefinition -t | GQL.TypeDefinition TypeDefinition -t <- [TypeSystemDefinition] -allTypes] - schTypes :: [TypeSystemDefinition] -schTypes = [TypeSystemDefinition -t | t :: TypeSystemDefinition -t@GQL.SchemaDefinition {} <- [TypeSystemDefinition] -allTypes] - typeMap :: TypeMap -typeMap = [TypeDefinition] -> TypeMap +serviceName + types :: [TypeDefinition] +types = [TypeDefinition +t | GQL.TypeDefinition TypeDefinition +t <- [TypeSystemDefinition] +allTypes] + schTypes :: [TypeSystemDefinition] +schTypes = [TypeSystemDefinition +t | t :: TypeSystemDefinition +t@GQL.SchemaDefinition {} <- [TypeSystemDefinition] +allTypes] + typeMap :: TypeMap +typeMap = [TypeDefinition] -> TypeMap classify [TypeDefinition] -types - schMap :: SchemaMap -schMap = [TypeSystemDefinition] -> SchemaMap +types + schMap :: SchemaMap +schMap = [TypeSystemDefinition] -> SchemaMap classifySchema [TypeSystemDefinition] -schTypes - [Result] -rs <- (TypeDefinition -> Q Result) -> [TypeDefinition] -> Q [Result] +schTypes + [Result] +rs <- (TypeDefinition -> Q Result) -> [TypeDefinition] -> Q [Result] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (Primitives -> Name -> TypeMap -> SchemaMap -> TypeDefinition -> Q Result typeToDec Primitives -prims Name -schemaName' TypeMap -typeMap SchemaMap -schMap) [TypeDefinition] -types - let schemaTypes :: [Type] -schemaTypes = [Type -x | GQLSchema Type -x <- [Result] -rs] - serviceTypes :: [Type] -serviceTypes = [Type -x | GQLService Type -x [(Text, (Text, (Text, Type)))] +prims Name +schemaName' TypeMap +typeMap SchemaMap +schMap) [TypeDefinition] +types + let schemaTypes :: [Type] +schemaTypes = [Type +x | GQLSchema Type +x <- [Result] +rs] + serviceTypes :: [Type] +serviceTypes = [Type +x | GQLService Type +x [(Text, (Text, (Text, Type)))] _ <- [Result] -rs] - defaultDefs :: [(Text, (Text, (Text, Type)))] -defaultDefs = [[(Text, (Text, (Text, Type)))]] -> [(Text, (Text, (Text, Type)))] +rs] + defaultDefs :: [(Text, (Text, (Text, Type)))] +defaultDefs = [[(Text, (Text, (Text, Type)))]] -> [(Text, (Text, (Text, Type)))] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [[(Text, (Text, (Text, Type)))] -d | GQLService Type -_ [(Text, (Text, (Text, Type)))] -d <- [Result] -rs] - Dec -schemaDec <- Name -> [TyVarBndr] -> TypeQ -> DecQ +d | GQLService Type +_ [(Text, (Text, (Text, Type)))] +d <- [Result] +rs] + Dec +schemaDec <- Name -> [TyVarBndr] -> TypeQ -> DecQ tySynD Name -schemaName' [] (Type -> TypeQ +schemaName' [] (Type -> TypeQ forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> TypeQ) -> Type -> TypeQ forall a b. (a -> b) -> a -> b $ [Type] -> Type typesToList [Type] -schemaTypes) - Type -pkgTy <- [t| 'Package ('Just $(textToStrLit $ T.pack serviceName)) +schemaTypes) + Type +pkgTy <- [t| 'Package ('Just $(textToStrLit $ T.pack serviceName)) $(pure $ typesToList serviceTypes) |] - Dec -serviceDec <- Name -> [TyVarBndr] -> TypeQ -> DecQ + Dec +serviceDec <- Name -> [TyVarBndr] -> TypeQ -> DecQ tySynD Name -serviceName' [] (Type -> TypeQ +serviceName' [] (Type -> TypeQ forall (f :: * -> *) a. Applicative f => a -> f a pure Type -pkgTy) - [Dec] -defaultDec <- [d| type instance AnnotatedPackage DefaultValue $(pure pkgTy) = +pkgTy) + [Dec] +defaultDec <- [d| type instance AnnotatedPackage DefaultValue $(pure pkgTy) = $(typesToList <$> traverse defaultDeclToTy defaultDefs) |] [Dec] -> Q [Dec] forall (f :: * -> *) a. Applicative f => a -> f a pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec] forall a b. (a -> b) -> a -> b $ Dec -schemaDec Dec -> [Dec] -> [Dec] +schemaDec Dec -> [Dec] -> [Dec] forall a. a -> [a] -> [a] : Dec -serviceDec Dec -> [Dec] -> [Dec] +serviceDec Dec -> [Dec] -> [Dec] forall a. a -> [a] -> [a] : [Dec] -defaultDec +defaultDec defaultDeclToTy :: (T.Text, (T.Text, (T.Text, Type))) -> Q Type defaultDeclToTy :: (Text, (Text, (Text, Type))) -> TypeQ -defaultDeclToTy (Text -sn, (Text -mn, (Text -an, Type -dv))) +defaultDeclToTy (Text +sn, (Text +mn, (Text +an, Type +dv))) = [t| 'AnnArg $(textToStrLit sn) $(textToStrLit mn) $(textToStrLit an) $(pure dv) |] -- | Reads a GraphQL 'TypeDefinition' and returns a 'Result'. @@ -393,18 +393,18 @@ forall (m :: * -> *) a. MonadFail m => String -> m a _ TypeMap _ SchemaMap _ (GQL.UnionTypeDefinition Description -_ Text -nm [Directive] -_ (GQL.UnionMemberTypes [Text] -elts)) = do - [Type] -selts <- (Text -> TypeQ) -> [Text] -> Q [Type] +_ Text +nm [Directive] +_ (GQL.UnionMemberTypes [Text] +elts)) = do + [Type] +selts <- (Text -> TypeQ) -> [Text] -> Q [Type] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Text -> TypeQ textToStrLit [Text] -elts +elts Type -> [(Text, (Text, (Text, Type)))] -> Result GQLService (Type -> [(Text, (Text, (Text, Type)))] -> Result) -> TypeQ -> Q ([(Text, (Text, (Text, Type)))] -> Result) @@ -417,36 +417,36 @@ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f <*> [(Text, (Text, (Text, Type)))] -> Q [(Text, (Text, (Text, Type)))] forall (f :: * -> *) a. Applicative f => a -> f a pure [] -typeToDec Primitives -prims Name -schemaName TypeMap -tm SchemaMap +typeToDec Primitives +prims Name +schemaName TypeMap +tm SchemaMap _ (GQL.ScalarTypeDefinition Description -_ Text -s [Directive] +_ Text +s [Directive] _) = Result GQLScalar Result -> TypeQ -> Q Result forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Primitives -> Text -> TypeMap -> Name -> TypeQ gqlTypeToType Primitives -prims Text -s TypeMap -tm Name -schemaName -typeToDec Primitives -prims Name -schemaName TypeMap -tm SchemaMap -sm (GQL.ObjectTypeDefinition Description -_ Text -nm ImplementsInterfaces [] +prims Text +s TypeMap +tm Name +schemaName +typeToDec Primitives +prims Name +schemaName TypeMap +tm SchemaMap +sm (GQL.ObjectTypeDefinition Description +_ Text +nm ImplementsInterfaces [] _ [Directive] -_ [FieldDefinition] -flds) = do - ([Type] -fieldInfos, [[(Text, (Text, Type))]] -defaults) <- [(Type, [(Text, (Text, Type))])] +_ [FieldDefinition] +flds) = do + ([Type] +fieldInfos, [[(Text, (Text, Type))]] +defaults) <- [(Type, [(Text, (Text, Type))])] -> ([Type], [[(Text, (Text, Type))]]) forall a b. [(a, b)] -> ([a], [b]) unzip ([(Type, [(Text, (Text, Type))])] @@ -460,9 +460,9 @@ forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (Text -> FieldDefinition -> Q (Type, [(Text, (Text, Type))]) -gqlFieldToType Text -nm) [FieldDefinition] -flds +gqlFieldToType Text +nm) [FieldDefinition] +flds Type -> [(Text, (Text, (Text, Type)))] -> Result GQLService (Type -> [(Text, (Text, (Text, Type)))] -> Result) -> TypeQ -> Q ([(Text, (Text, (Text, Type)))] -> Result) @@ -475,27 +475,27 @@ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f <*> [(Text, (Text, (Text, Type)))] -> Q [(Text, (Text, (Text, Type)))] forall (f :: * -> *) a. Applicative f => a -> f a pure ((Text -nm,) ((Text, (Text, Type)) -> (Text, (Text, (Text, Type)))) +nm,) ((Text, (Text, Type)) -> (Text, (Text, (Text, Type)))) -> [(Text, (Text, Type))] -> [(Text, (Text, (Text, Type)))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [[(Text, (Text, Type))]] -> [(Text, (Text, Type))] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [[(Text, (Text, Type))]] -defaults) +defaults) where - gqlFieldToType :: T.Text -> GQL.FieldDefinition + gqlFieldToType :: T.Text -> GQL.FieldDefinition -> Q (Type, [(T.Text, (T.Text, Type))]) - gqlFieldToType :: Text -> FieldDefinition -> Q (Type, [(Text, (Text, Type))]) -gqlFieldToType Text -sn (GQL.FieldDefinition Description -_ Text -fnm (GQL.ArgumentsDefinition [InputValueDefinition] -args) Type -ftyp [Directive] + gqlFieldToType :: Text -> FieldDefinition -> Q (Type, [(Text, (Text, Type))]) +gqlFieldToType Text +sn (GQL.FieldDefinition Description +_ Text +fnm (GQL.ArgumentsDefinition [InputValueDefinition] +args) Type +ftyp [Directive] _) = do - ([Type] -argInfos, [Maybe (Text, Type)] -defaults) <- [(Type, Maybe (Text, Type))] -> ([Type], [Maybe (Text, Type)]) + ([Type] +argInfos, [Maybe (Text, Type)] +defaults) <- [(Type, Maybe (Text, Type))] -> ([Type], [Maybe (Text, Type)]) forall a b. [(a, b)] -> ([a], [b]) unzip ([(Type, Maybe (Text, Type))] -> ([Type], [Maybe (Text, Type)])) -> Q [(Type, Maybe (Text, Type))] @@ -507,8 +507,8 @@ forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse InputValueDefinition -> Q (Type, Maybe (Text, Type)) -argToType [InputValueDefinition] -args +argToType [InputValueDefinition] +args (,) (Type -> [(Text, (Text, Type))] -> (Type, [(Text, (Text, Type))])) -> TypeQ -> Q ([(Text, (Text, Type))] -> (Type, [(Text, (Text, Type))])) @@ -522,33 +522,33 @@ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f <*> [(Text, (Text, Type))] -> Q [(Text, (Text, Type))] forall (f :: * -> *) a. Applicative f => a -> f a pure ((Text -fnm,) ((Text, Type) -> (Text, (Text, Type))) +fnm,) ((Text, Type) -> (Text, (Text, Type))) -> [(Text, Type)] -> [(Text, (Text, Type))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Maybe (Text, Type)] -> [(Text, Type)] forall a. [Maybe a] -> [a] catMaybes [Maybe (Text, Type)] -defaults) - returnType :: T.Text -> GQL.Type -> Q Type - returnType :: Text -> Type -> TypeQ -returnType Text -serviceName Type -typ = +defaults) + returnType :: T.Text -> GQL.Type -> Q Type + returnType :: Text -> Type -> TypeQ +returnType Text +serviceName Type +typ = case Text -> SchemaMap -> Maybe OperationType forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -serviceName SchemaMap -sm of +serviceName SchemaMap +sm of Just OperationType GQL.Subscription -> [t|'RetStream $(retToType typ)|] Maybe OperationType _ -> [t|'RetSingle $(retToType typ)|] - argToType :: GQL.InputValueDefinition -> Q (Type, Maybe (T.Text, Type)) - argToType :: InputValueDefinition -> Q (Type, Maybe (Text, Type)) -argToType (GQL.InputValueDefinition Description -_ Text -aname Type -atype Maybe (Node ConstValue) + argToType :: GQL.InputValueDefinition -> Q (Type, Maybe (T.Text, Type)) + argToType :: InputValueDefinition -> Q (Type, Maybe (Text, Type)) +argToType (GQL.InputValueDefinition Description +_ Text +aname Type +atype Maybe (Node ConstValue) Nothing [Directive] _) = (, Maybe (Text, Type) @@ -557,11 +557,11 @@ forall a. Maybe a -> TypeQ -> Q (Type, Maybe (Text, Type)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [t| 'ArgSingle ('Just $(textToStrLit aname)) $(retToType atype) |] - argToType (GQL.InputValueDefinition Description -_ Text -aname Type -atype (Just (GQL.Node ConstValue -defs Location + argToType (GQL.InputValueDefinition Description +_ Text +aname Type +atype (Just (GQL.Node ConstValue +defs Location _)) [Directive] _) = (,) (Type -> Maybe (Text, Type) -> (Type, Maybe (Text, Type))) @@ -577,127 +577,127 @@ forall a. a -> Maybe a -> (Type -> (Text, Type)) -> Type -> Maybe (Text, Type) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Text -aname,) (Type -> Maybe (Text, Type)) -> TypeQ -> Q (Maybe (Text, Type)) +aname,) (Type -> Maybe (Text, Type)) -> TypeQ -> Q (Maybe (Text, Type)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [t| 'DefaultValue $( defToVConst defs ) |]) - defToVConst :: GQL.ConstValue -> Q Type - defToVConst :: ConstValue -> TypeQ -defToVConst (GQL.ConstBoolean Bool + defToVConst :: GQL.ConstValue -> Q Type + defToVConst :: ConstValue -> TypeQ +defToVConst (GQL.ConstBoolean Bool _) = [t| 'VCBoolean|] - defToVConst ConstValue + defToVConst ConstValue GQL.ConstNull = [t| 'VCNull |] - defToVConst (GQL.ConstInt Int32 + defToVConst (GQL.ConstInt Int32 _) = [t| 'VCInt |] - defToVConst (GQL.ConstFloat Double + defToVConst (GQL.ConstFloat Double _) = String -> TypeQ forall (m :: * -> *) a. MonadFail m => String -> m a fail String "floats as default arguments are not supported" - defToVConst (GQL.ConstString Text -s) + defToVConst (GQL.ConstString Text +s) = [t| 'VCString $(textToStrLit s) |] - defToVConst (GQL.ConstEnum Text -e) + defToVConst (GQL.ConstEnum Text +e) = [t| 'VCEnum $(textToStrLit e) |] - defToVConst (GQL.ConstList [Node ConstValue] -xs) + defToVConst (GQL.ConstList [Node ConstValue] +xs) = [t| 'VCList $(typesToList <$> traverse (defToVConst . GQL.node) xs) |] - defToVConst (GQL.ConstObject [ObjectField ConstValue] -obj) + defToVConst (GQL.ConstObject [ObjectField ConstValue] +obj) = [t| 'VCObject $(typesToList <$> traverse fromGQLField obj) |] - fromGQLField :: GQL.ObjectField GQL.ConstValue -> Q Type - fromGQLField :: ObjectField ConstValue -> TypeQ -fromGQLField (GQL.ObjectField Text -n (GQL.Node ConstValue -v Location + fromGQLField :: GQL.ObjectField GQL.ConstValue -> Q Type + fromGQLField :: ObjectField ConstValue -> TypeQ +fromGQLField (GQL.ObjectField Text +n (GQL.Node ConstValue +v Location _) Location _) = [t| ($(textToStrLit n), $(defToVConst v)) |] - retToType :: GQL.Type -> Q Type - retToType :: Type -> TypeQ -retToType (GQL.TypeNonNull (GQL.NonNullTypeNamed Text -a)) = + retToType :: GQL.Type -> Q Type + retToType :: Type -> TypeQ +retToType (GQL.TypeNonNull (GQL.NonNullTypeNamed Text +a)) = [t| $(gqlTypeToType prims a tm schemaName) |] - retToType (GQL.TypeNonNull (GQL.NonNullTypeList Type -a)) = + retToType (GQL.TypeNonNull (GQL.NonNullTypeList Type +a)) = [t| 'ListRef $(retToType a) |] - retToType (GQL.TypeNamed Text -a) = + retToType (GQL.TypeNamed Text +a) = [t| 'OptionalRef $(gqlTypeToType prims a tm schemaName) |] - retToType (GQL.TypeList Type -a) = + retToType (GQL.TypeList Type +a) = [t| 'OptionalRef ('ListRef $(retToType a)) |] typeToDec Primitives _ Name _ TypeMap _ SchemaMap _ (GQL.EnumTypeDefinition Description -_ Text -name [Directive] -_ [EnumValueDefinition] -symbols) = +_ Text +name [Directive] +_ [EnumValueDefinition] +symbols) = Type -> Result GQLSchema (Type -> Result) -> TypeQ -> Q Result forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [t|'DEnum $(textToStrLit name) $(typesToList <$> traverse gqlChoiceToType symbols)|] where - gqlChoiceToType :: GQL.EnumValueDefinition -> Q Type - gqlChoiceToType :: EnumValueDefinition -> TypeQ -gqlChoiceToType (GQL.EnumValueDefinition Description -_ Text -c [Directive] + gqlChoiceToType :: GQL.EnumValueDefinition -> Q Type + gqlChoiceToType :: EnumValueDefinition -> TypeQ +gqlChoiceToType (GQL.EnumValueDefinition Description +_ Text +c [Directive] _) = [t|'ChoiceDef $(textToStrLit c)|] -typeToDec Primitives -prims Name +typeToDec Primitives +prims Name _ TypeMap _ SchemaMap _ (GQL.InputObjectTypeDefinition Description -_ Text -name [Directive] -_ [InputValueDefinition] -fields) = +_ Text +name [Directive] +_ [InputValueDefinition] +fields) = Type -> Result GQLSchema (Type -> Result) -> TypeQ -> Q Result forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [t|'DRecord $(textToStrLit name) $(typesToList <$> traverse gqlFieldToType fields)|] where - gqlFieldToType :: GQL.InputValueDefinition -> Q Type - gqlFieldToType :: InputValueDefinition -> TypeQ -gqlFieldToType (GQL.InputValueDefinition Description -_ Text -fname Type -ftype Maybe (Node ConstValue) + gqlFieldToType :: GQL.InputValueDefinition -> Q Type + gqlFieldToType :: InputValueDefinition -> TypeQ +gqlFieldToType (GQL.InputValueDefinition Description +_ Text +fname Type +ftype Maybe (Node ConstValue) _ [Directive] _) = [t|'FieldDef $(textToStrLit fname) $(ginputTypeToType ftype)|] - ginputTypeToType :: GQL.Type -> Q Type - ginputTypeToType :: Type -> TypeQ -ginputTypeToType (GQL.TypeNonNull (GQL.NonNullTypeNamed Text -a)) = - [t| $(typeToPrimType a) |] - ginputTypeToType (GQL.TypeNonNull (GQL.NonNullTypeList Type + ginputTypeToType :: GQL.Type -> Q Type + ginputTypeToType :: Type -> TypeQ +ginputTypeToType (GQL.TypeNonNull (GQL.NonNullTypeNamed Text a)) = + [t| $(typeToPrimType a) |] + ginputTypeToType (GQL.TypeNonNull (GQL.NonNullTypeList Type +a)) = [t| 'TList $(ginputTypeToType a) |] - ginputTypeToType (GQL.TypeNamed Text -a) = - [t| 'TOption $(typeToPrimType a) |] - ginputTypeToType (GQL.TypeList Type + ginputTypeToType (GQL.TypeNamed Text a) = + [t| 'TOption $(typeToPrimType a) |] + ginputTypeToType (GQL.TypeList Type +a) = [t| 'TOption ('TList $(ginputTypeToType a)) |] - typeToPrimType :: GQL.Name -> Q Type - typeToPrimType :: Text -> TypeQ -typeToPrimType Text -nm + typeToPrimType :: GQL.Name -> Q Type + typeToPrimType :: Text -> TypeQ +typeToPrimType Text +nm = case Text -> Primitives -> Maybe TypeQ forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Text -nm Primitives -prims of - Just TypeQ -ty -> [t|'TPrimitive $ty|] +nm Primitives +prims of + Just TypeQ +ty -> [t|'TPrimitive $ty|] Maybe TypeQ Nothing -> [t|'TSchematic $(textToStrLit nm)|] @@ -706,33 +706,33 @@ forall a b. Eq a => a -> [(a, b)] -> Maybe b gqlTypeToType :: Primitives -> GQL.Name -> TypeMap -> Name -> Q Type gqlTypeToType :: Primitives -> Text -> TypeMap -> Name -> TypeQ -gqlTypeToType Primitives -prims Text -name TypeMap -tm Name -schemaName +gqlTypeToType Primitives +prims Text +name TypeMap +tm Name +schemaName = case Text -> Primitives -> Maybe TypeQ forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Text -name Primitives -prims of - Just TypeQ -ty -> [t|'PrimitiveRef $ty|] +name Primitives +prims of + Just TypeQ +ty -> [t|'PrimitiveRef $ty|] Maybe TypeQ Nothing - -> let schemaRef :: TypeQ -schemaRef = [t|'SchemaRef $(conT schemaName) $(textToStrLit name)|] + -> let schemaRef :: TypeQ +schemaRef = [t|'SchemaRef $(conT schemaName) $(textToStrLit name)|] in case Text -> TypeMap -> Maybe GQLType forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -name TypeMap -tm of +name TypeMap +tm of Just GQLType Enum -> TypeQ -schemaRef +schemaRef Just GQLType InputObject -> TypeQ -schemaRef +schemaRef Maybe GQLType _ -> [t|'ObjectRef $(textToStrLit name)|] diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Definition.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Definition.html index 77971bc..c4e7e20 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Definition.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Definition.html @@ -13,121 +13,121 @@ import Mu.Rpc import Mu.Schema -data Document (p :: Package snm mnm anm (TypeRef snm)) - (qr :: Maybe snm) (mut :: Maybe snm) (sub :: Maybe snm) where - QueryDoc - :: LookupService ss qr ~ 'Service qr qms - => ServiceQuery ('Package pname ss) (LookupService ss qr) - -> Document ('Package pname ss) ('Just qr) mut sub - MutationDoc - :: LookupService ss mut ~ 'Service mut mms - => ServiceQuery ('Package pname ss) (LookupService ss mut) - -> Document ('Package pname ss) qr ('Just mut) sub - SubscriptionDoc - :: LookupService ss sub ~ 'Service sub mms - => OneMethodQuery ('Package pname ss) (LookupService ss sub) - -> Document ('Package pname ss) qr mut ('Just sub) +data Document (p :: Package snm mnm anm (TypeRef snm)) + (qr :: Maybe snm) (mut :: Maybe snm) (sub :: Maybe snm) where + QueryDoc + :: LookupService ss qr ~ 'Service qr qms + => ServiceQuery ('Package pname ss) (LookupService ss qr) + -> Document ('Package pname ss) ('Just qr) mut sub + MutationDoc + :: LookupService ss mut ~ 'Service mut mms + => ServiceQuery ('Package pname ss) (LookupService ss mut) + -> Document ('Package pname ss) qr ('Just mut) sub + SubscriptionDoc + :: LookupService ss sub ~ 'Service sub mms + => OneMethodQuery ('Package pname ss) (LookupService ss sub) + -> Document ('Package pname ss) qr mut ('Just sub) -data ServiceQuery (p :: Package snm mnm anm (TypeRef snm)) - (s :: Service snm mnm anm (TypeRef snm)) where - ServiceQuery :: [OneMethodQuery p ('Service nm ms)] - -> ServiceQuery p ('Service nm ms) - OneOfQuery :: NP (ChosenOneOfQuery p) elts - -> ServiceQuery p ('OneOf nm elts) +data ServiceQuery (p :: Package snm mnm anm (TypeRef snm)) + (s :: Service snm mnm anm (TypeRef snm)) where + ServiceQuery :: [OneMethodQuery p ('Service nm ms)] + -> ServiceQuery p ('Service nm ms) + OneOfQuery :: NP (ChosenOneOfQuery p) elts + -> ServiceQuery p ('OneOf nm elts) -data OneMethodQuery (p :: Package snm mnm anm (TypeRef snm)) - (s :: Service snm mnm anm (TypeRef snm)) where - OneMethodQuery +data OneMethodQuery (p :: Package snm mnm anm (TypeRef snm)) + (s :: Service snm mnm anm (TypeRef snm)) where + OneMethodQuery :: Maybe Text - -> NS (ChosenMethodQuery p) ms - -> OneMethodQuery p ('Service nm ms) + -> NS (ChosenMethodQuery p) ms + -> OneMethodQuery p ('Service nm ms) -- the special '__typename' field - TypeNameQuery + TypeNameQuery :: Maybe Text - -> OneMethodQuery p s + -> OneMethodQuery p s -- introspection fields - SchemaQuery + SchemaQuery :: Maybe Text -> [GQL.Selection] - -> OneMethodQuery p s - TypeQuery + -> OneMethodQuery p s + TypeQuery :: Maybe Text -> Text -> [GQL.Selection] - -> OneMethodQuery p s + -> OneMethodQuery p s -data ChosenOneOfQuery p elt where - ChosenOneOfQuery - :: Typeable elt => Proxy elt - -> ServiceQuery ('Package pname ss) (LookupService ss elt) - -> ChosenOneOfQuery ('Package pname ss) elt +data ChosenOneOfQuery p elt where + ChosenOneOfQuery + :: Typeable elt => Proxy elt + -> ServiceQuery ('Package pname ss) (LookupService ss elt) + -> ChosenOneOfQuery ('Package pname ss) elt -data ChosenMethodQuery (p :: Package snm mnm anm (TypeRef snm)) - (m :: Method snm mnm anm (TypeRef snm)) where - ChosenMethodQuery +data ChosenMethodQuery (p :: Package snm mnm anm (TypeRef snm)) + (m :: Method snm mnm anm (TypeRef snm)) where + ChosenMethodQuery :: GQL.Field - -> NP (ArgumentValue p) args - -> ReturnQuery p r - -> ChosenMethodQuery p ('Method mname args r) + -> NP (ArgumentValue p) args + -> ReturnQuery p r + -> ChosenMethodQuery p ('Method mname args r) -data ArgumentValue (p :: Package snm mnm anm (TypeRef snm)) - (a :: Argument snm anm (TypeRef snm)) where - ArgumentValue :: ArgumentValue' p r - -> ArgumentValue p ('ArgSingle aname r) - ArgumentStream :: ArgumentValue' p ('ListRef r) - -> ArgumentValue p ('ArgStream aname r) +data ArgumentValue (p :: Package snm mnm anm (TypeRef snm)) + (a :: Argument snm anm (TypeRef snm)) where + ArgumentValue :: ArgumentValue' p r + -> ArgumentValue p ('ArgSingle aname r) + ArgumentStream :: ArgumentValue' p ('ListRef r) + -> ArgumentValue p ('ArgStream aname r) -data ArgumentValue' (p :: Package snm mnm anm (TypeRef snm)) - (r :: TypeRef snm) where - ArgPrimitive :: t -> ArgumentValue' p ('PrimitiveRef t) - ArgSchema :: Term sch (sch :/: sty) - -> ArgumentValue' p ('SchemaRef sch sty) - ArgList :: [ArgumentValue' p r] - -> ArgumentValue' p ('ListRef r) - ArgOptional :: Maybe (ArgumentValue' p r) - -> ArgumentValue' p ('OptionalRef r) +data ArgumentValue' (p :: Package snm mnm anm (TypeRef snm)) + (r :: TypeRef snm) where + ArgPrimitive :: t -> ArgumentValue' p ('PrimitiveRef t) + ArgSchema :: Term sch (sch :/: sty) + -> ArgumentValue' p ('SchemaRef sch sty) + ArgList :: [ArgumentValue' p r] + -> ArgumentValue' p ('ListRef r) + ArgOptional :: Maybe (ArgumentValue' p r) + -> ArgumentValue' p ('OptionalRef r) -data ReturnQuery (p :: Package snm mnm anm (TypeRef snm)) - (r :: Return snm (TypeRef snm)) where - RNothing :: ReturnQuery p 'RetNothing - RSingle :: ReturnQuery' p r -> ReturnQuery p ('RetSingle r) - RStream :: ReturnQuery' p r -> ReturnQuery p ('RetStream r) +data ReturnQuery (p :: Package snm mnm anm (TypeRef snm)) + (r :: Return snm (TypeRef snm)) where + RNothing :: ReturnQuery p 'RetNothing + RSingle :: ReturnQuery' p r -> ReturnQuery p ('RetSingle r) + RStream :: ReturnQuery' p r -> ReturnQuery p ('RetStream r) -data ReturnQuery' (p :: Package snm mnm anm (TypeRef snm)) - (r :: TypeRef snm) where - RetPrimitive :: ReturnQuery' p ('PrimitiveRef t) - RetSchema :: SchemaQuery sch (sch :/: sty) - -> ReturnQuery' p ('SchemaRef sch sty) - RetList :: ReturnQuery' p r -> ReturnQuery' p ('ListRef r) - RetOptional :: ReturnQuery' p r -> ReturnQuery' p ('OptionalRef r) - RetObject :: ServiceQuery ('Package pname ss) (LookupService ss s) - -> ReturnQuery' ('Package pname ss) ('ObjectRef s) +data ReturnQuery' (p :: Package snm mnm anm (TypeRef snm)) + (r :: TypeRef snm) where + RetPrimitive :: ReturnQuery' p ('PrimitiveRef t) + RetSchema :: SchemaQuery sch (sch :/: sty) + -> ReturnQuery' p ('SchemaRef sch sty) + RetList :: ReturnQuery' p r -> ReturnQuery' p ('ListRef r) + RetOptional :: ReturnQuery' p r -> ReturnQuery' p ('OptionalRef r) + RetObject :: ServiceQuery ('Package pname ss) (LookupService ss s) + -> ReturnQuery' ('Package pname ss) ('ObjectRef s) -data SchemaQuery (sch :: Schema tn fn) (t :: TypeDef tn fn) where - QueryEnum :: SchemaQuery sch ('DEnum nm choices) - QueryRecord :: [OneFieldQuery sch fs] - -> SchemaQuery sch ('DRecord ty fs) +data SchemaQuery (sch :: Schema tn fn) (t :: TypeDef tn fn) where + QueryEnum :: SchemaQuery sch ('DEnum nm choices) + QueryRecord :: [OneFieldQuery sch fs] + -> SchemaQuery sch ('DRecord ty fs) -data OneFieldQuery (sch :: Schema tn fn) (fs :: [FieldDef tn fn]) where - OneFieldQuery +data OneFieldQuery (sch :: Schema tn fn) (fs :: [FieldDef tn fn]) where + OneFieldQuery :: Maybe Text - -> NS (ChosenFieldQuery sch) fs - -> OneFieldQuery sch fs - TypeNameFieldQuery + -> NS (ChosenFieldQuery sch) fs + -> OneFieldQuery sch fs + TypeNameFieldQuery :: Maybe Text - -> OneFieldQuery sch fs + -> OneFieldQuery sch fs -data ChosenFieldQuery (sch :: Schema tn fn) (f :: FieldDef tn fn) where - ChosenFieldQuery - :: ReturnSchemaQuery sch r - -> ChosenFieldQuery sch ('FieldDef name r) +data ChosenFieldQuery (sch :: Schema tn fn) (f :: FieldDef tn fn) where + ChosenFieldQuery + :: ReturnSchemaQuery sch r + -> ChosenFieldQuery sch ('FieldDef name r) -data ReturnSchemaQuery (sch :: Schema tn fn) (r :: FieldType tn) where - RetSchPrimitive :: ReturnSchemaQuery sch ('TPrimitive t) - RetSchSchema :: SchemaQuery sch (sch :/: sty) - -> ReturnSchemaQuery sch ('TSchematic sty) - RetSchList :: ReturnSchemaQuery sch r - -> ReturnSchemaQuery sch ('TList r) - RetSchOptional :: ReturnSchemaQuery sch r - -> ReturnSchemaQuery sch ('TOption r) +data ReturnSchemaQuery (sch :: Schema tn fn) (r :: FieldType tn) where + RetSchPrimitive :: ReturnSchemaQuery sch ('TPrimitive t) + RetSchSchema :: SchemaQuery sch (sch :/: sty) + -> ReturnSchemaQuery sch ('TSchematic sty) + RetSchList :: ReturnSchemaQuery sch r + -> ReturnSchemaQuery sch ('TList r) + RetSchOptional :: ReturnSchemaQuery sch r + -> ReturnSchemaQuery sch ('TOption r) \ No newline at end of file diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Introspection.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Introspection.html index a5de6af..66b251b 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Introspection.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Introspection.html @@ -33,7 +33,7 @@ subscriptionType :: Maybe T.Text , Schema -> TypeMap types :: TypeMap } - deriving Int -> Schema -> ShowS + deriving Int -> Schema -> ShowS [Schema] -> ShowS Schema -> String (Int -> Schema -> ShowS) @@ -65,7 +65,7 @@ $cshowsPrec :: Int -> Schema -> ShowS } | TypeRef { Type -> Text to :: T.Text } - deriving Int -> Type -> ShowS + deriving Int -> Type -> ShowS [Type] -> ShowS Type -> String (Int -> Type -> ShowS) @@ -89,7 +89,7 @@ $cshowsPrec :: Int -> Type -> ShowS , Field -> Type fieldType :: Type } - deriving Int -> Field -> ShowS + deriving Int -> Field -> ShowS [Field] -> ShowS Field -> String (Int -> Field -> ShowS) @@ -113,7 +113,7 @@ $cshowsPrec :: Int -> Field -> ShowS , Input -> Type inputType :: Type } - deriving Int -> Input -> ShowS + deriving Int -> Input -> ShowS [Input] -> ShowS Input -> String (Int -> Input -> ShowS) @@ -131,7 +131,7 @@ $cshowsPrec :: Int -> Input -> ShowS newtype EnumValue = EnumValue { EnumValue -> Text enumValueName :: T.Text } - deriving Int -> EnumValue -> ShowS + deriving Int -> EnumValue -> ShowS [EnumValue] -> ShowS EnumValue -> String (Int -> EnumValue -> ShowS) @@ -157,7 +157,7 @@ $cshowsPrec :: Int -> EnumValue -> ShowS | INPUT_OBJECT | LIST | NON_NULL - deriving Int -> TypeKind -> ShowS + deriving Int -> TypeKind -> ShowS [TypeKind] -> ShowS TypeKind -> String (Int -> TypeKind -> ShowS) @@ -174,8 +174,8 @@ $cshowsPrec :: Int -> TypeKind -> ShowS tSimple :: T.Text -> Type tSimple :: Text -> Type -tSimple Text -t = TypeKind +tSimple Text +t = TypeKind -> Maybe Text -> [Field] -> [EnumValue] @@ -186,7 +186,7 @@ $cshowsPrec :: Int -> TypeKind -> ShowS SCALAR (Text -> Maybe Text forall a. a -> Maybe a Just Text -t) [] [] [] Maybe Type +t) [] [] [] Maybe Type forall a. Maybe a Nothing @@ -233,9 +233,9 @@ forall a. a -> Maybe a _ [Field] _ [EnumValue] _ [Type] -_ Maybe Type -x) = Maybe Type -x +_ Maybe Type +x) = Maybe Type +x unwrapNonNull Type _ = Maybe Type forall a. Maybe a @@ -244,28 +244,28 @@ forall a. Maybe a -- BUILD INTROSPECTION DATA -- ======================== -class Introspect (p :: Package') - (qr :: Maybe Symbol) - (mut :: Maybe Symbol) - (sub :: Maybe Symbol) where +class Introspect (p :: Package') + (qr :: Maybe Symbol) + (mut :: Maybe Symbol) + (sub :: Maybe Symbol) where introspect - :: Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema + :: 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) +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) +introspect Proxy ('Package nm ss) _ Proxy qr _ Proxy mut _ Proxy sub _ = let (() -_, TypeMap -ts) = Writer TypeMap () -> ((), TypeMap) +_, TypeMap +ts) = Writer TypeMap () -> ((), TypeMap) forall w a. Writer w a -> (a, w) runWriter (Writer TypeMap () -> ((), TypeMap)) -> Writer TypeMap () -> ((), TypeMap) @@ -277,9 +277,9 @@ IntrospectServices ss sub => Proxy ss -> Proxy sub -> Writer TypeMap () introspectServices (Proxy ss forall k (t :: k). Proxy t -Proxy @ss) (Proxy sub +Proxy @ss) (Proxy sub forall k (t :: k). Proxy t -Proxy @sub) Writer TypeMap () -> Writer TypeMap () -> Writer TypeMap () +Proxy @sub) Writer TypeMap () -> Writer TypeMap () -> Writer TypeMap () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> TypeMap -> Writer TypeMap () @@ -287,11 +287,11 @@ 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 + (\Text +i -> (Text +i, Text -> Type tSimple Text -i)) +i)) (Text -> (Text, Type)) -> [Text] -> [(Text, Type)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ Text @@ -306,182 +306,182 @@ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b "JSON", Text "JSONObject" ] )) -- return only reachable types - qrS :: Maybe Text -qrS = Proxy qr -> Maybe Text + 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 +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 +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 +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 +qrS, Maybe Text +mutS, Maybe Text +subS] + reach :: HashSet Text +reach = TypeMap -> HashSet Text -> HashSet Text reachableFrom TypeMap -ts HashSet Text -initials +ts HashSet Text +initials -- - finalTs :: TypeMap -finalTs = (Text -> Type -> Bool) -> TypeMap -> TypeMap + 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 +HM.filterWithKey (\Text +k Type _ -> Text -k Text -> HashSet Text -> Bool +k Text -> HashSet Text -> Bool forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool `S.member` HashSet Text -reach) TypeMap -ts +reach) TypeMap +ts in Maybe Text -> Maybe Text -> Maybe Text -> TypeMap -> Schema Schema Maybe Text -qrS Maybe Text -mutS Maybe Text -subS TypeMap -finalTs +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] +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 +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] +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 +tys' + allReachable :: HashSet Text +allReachable = [HashSet Text] -> HashSet Text forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a S.unions [HashSet Text] -fromThis +fromThis in if HashSet Text -tys HashSet Text -> HashSet Text -> Bool +tys HashSet Text -> HashSet Text -> Bool forall a. Eq a => a -> a -> Bool == HashSet Text -allReachable +allReachable then HashSet Text -tys +tys else TypeMap -> HashSet Text -> HashSet Text reachableFrom TypeMap -mp HashSet Text -allReachable +mp HashSet Text +allReachable where - reachableFromOne :: T.Text -> [T.Text] - reachableFromOne :: Text -> [Text] -reachableFromOne Text -t + 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 {} +t TypeMap +mp of + Just ty :: Type +ty@Type {} -> Text -t Text -> [Text] -> [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] +reachableFromField (Type -> [Field] fields Type -ty) +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 + reachableFromField :: Field -> [T.Text] + reachableFromField :: Field -> [Text] +reachableFromField Field +f = Type -> [Text] -reachableFromType (Field -> Type +reachableFromType (Field -> Type fieldType Field -f) [Text] -> [Text] -> [Text] +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] +reachableFromInput (Field -> [Input] args Field -f) +f) - reachableFromInput :: Input -> [T.Text] - reachableFromInput :: Input -> [Text] -reachableFromInput Input -i = Type -> [Text] -reachableFromType (Input -> Type + reachableFromInput :: Input -> [T.Text] + reachableFromInput :: Input -> [Text] +reachableFromInput Input +i = Type -> [Text] +reachableFromType (Input -> Type inputType Input -i) +i) - reachableFromType :: Type -> [T.Text] - reachableFromType :: Type -> [Text] -reachableFromType (TypeRef Text -t) = [Text -t] - reachableFromType t :: Type -t@Type {} + 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' +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] +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) +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 @@ -495,40 +495,40 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy s forall k (t :: k). Proxy t -Proxy @s) +Proxy @s) instance KnownMaybeSymbol 'Nothing where - maybeSymbolVal :: Proxy 'Nothing -> Maybe Text -maybeSymbolVal Proxy 'Nothing + 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 +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 +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 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) +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 +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 @@ -537,19 +537,19 @@ 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] +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) +Proxy @smethods) (Proxy (IsSub sname sub) forall k (t :: k). Proxy t -Proxy @(IsSub sname sub)) - let t :: Type -t = TypeKind +Proxy @(IsSub sname sub)) + let t :: Type +t = TypeKind -> Maybe Text -> [Field] -> [EnumValue] @@ -560,8 +560,8 @@ forall k (t :: k). Proxy t OBJECT (Text -> Maybe Text forall a. a -> Maybe a Just Text -name) [Field] -fs [] [] Maybe Type +name) [Field] +fs [] [] Maybe Type forall a. Maybe a Nothing -- add this one to the mix @@ -570,8 +570,8 @@ 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) +name Type +t) -- continue with the rest Proxy ss -> Proxy sub -> Writer TypeMap () forall (ss :: [Service']) (sub :: Maybe Symbol). @@ -579,18 +579,18 @@ IntrospectServices ss sub => Proxy ss -> Proxy sub -> Writer TypeMap () introspectServices (Proxy ss forall k (t :: k). Proxy t -Proxy @ss) Proxy sub -psub +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 +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 @@ -599,18 +599,18 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy sname forall k (t :: k). Proxy t -Proxy @sname) - tys :: [Type] -tys = (Text -> Type) -> [Text] -> [Type] +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 +Proxy @elts)) + t :: Type +t = TypeKind -> Maybe Text -> [Field] -> [EnumValue] @@ -621,8 +621,8 @@ forall k (t :: k). Proxy t UNION (Text -> Maybe Text forall a. a -> Maybe a Just Text -name) [] [] [Type] -tys Maybe Type +name) [] [] [Type] +tys Maybe Type forall a. Maybe a Nothing -- add this one to the mix @@ -631,8 +631,8 @@ 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) +name Type +t) -- continue with the rest Proxy ss -> Proxy sub -> Writer TypeMap () forall (ss :: [Service']) (sub :: Maybe Symbol). @@ -640,19 +640,19 @@ IntrospectServices ss sub => Proxy ss -> Proxy sub -> Writer TypeMap () introspectServices (Proxy ss forall k (t :: k). Proxy t -Proxy @ss) Proxy sub -psub +Proxy @ss) Proxy sub +psub -class KnownSymbols (ss :: [Symbol]) where - symbolsVal :: Proxy ss -> [T.Text] +class KnownSymbols (ss :: [Symbol]) where + symbolsVal :: Proxy ss -> [T.Text] instance KnownSymbols '[] where - symbolsVal :: Proxy '[] -> [Text] -symbolsVal Proxy '[] + symbolsVal :: Proxy '[] -> [Text] +symbolsVal Proxy '[] _ = [] -instance (KnownSymbol s, KnownSymbols ss) - => KnownSymbols (s ': ss) where - symbolsVal :: Proxy (s : ss) -> [Text] -symbolsVal Proxy (s : ss) +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 -> *). @@ -660,36 +660,36 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy s forall k (t :: k). Proxy t -Proxy @s)) Text -> [Text] -> [Text] +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) +Proxy @ss) -class IntrospectFields (fs :: [Method']) (isSub :: Bool) where +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 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) +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 +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 @@ -698,32 +698,32 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy mname forall k (t :: k). Proxy t -Proxy @mname) - [Input] -inputs <- Proxy margs -> Writer TypeMap [Input] +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 +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 +Proxy @mret) Proxy isSub +pIsSub + let this :: Field +this = Text -> [Input] -> Type -> Field Field Text -name [Input] -inputs Type -ret +name [Input] +inputs Type +ret (Field -this Field -> [Field] -> [Field] +this Field -> [Field] -> [Field] forall a. a -> [a] -> [a] :) ([Field] -> [Field]) -> Writer TypeMap [Field] -> Writer TypeMap [Field] @@ -734,55 +734,55 @@ IntrospectFields fs isSub => Proxy fs -> Proxy isSub -> Writer TypeMap [Field] introspectFields (Proxy fs forall k (t :: k). Proxy t -Proxy @fs) Proxy isSub -pIsSub +Proxy @fs) Proxy isSub +pIsSub -class IntrospectInputs (args :: [Argument']) where +class IntrospectInputs (args :: [Argument']) where introspectInputs - :: Proxy args -> Writer TypeMap [Input] + :: Proxy args -> Writer TypeMap [Input] instance IntrospectInputs '[] where - introspectInputs :: Proxy '[] -> Writer TypeMap [Input] -introspectInputs Proxy '[] + 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) +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 + 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 +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 +Proxy @r) Bool False -- TODO: Find default value - let this :: Input -this = Text -> Maybe Text -> Type -> Input + 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 +nm) Maybe Text forall a. Maybe a Nothing Type -t +t (Input -this Input -> [Input] -> [Input] +this Input -> [Input] -> [Input] forall a. a -> [a] -> [a] :) ([Input] -> [Input]) -> Writer TypeMap [Input] -> Writer TypeMap [Input] @@ -793,24 +793,24 @@ 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) +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 + 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 +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 @@ -819,21 +819,21 @@ IntrospectTypeRef tr => Proxy tr -> Bool -> Writer TypeMap Type introspectTypeRef (Proxy r forall k (t :: k). Proxy t -Proxy @r) Bool +Proxy @r) Bool False -- TODO: Find default value - let this :: Input -this = Text -> Maybe Text -> Type -> Input + 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 +nm) Maybe Text forall a. Maybe a Nothing Type -t +t (Input -this Input -> [Input] -> [Input] +this Input -> [Input] -> [Input] forall a. a -> [a] -> [a] :) ([Input] -> [Input]) -> Writer TypeMap [Input] -> Writer TypeMap [Input] @@ -844,15 +844,15 @@ IntrospectInputs args => Proxy args -> Writer TypeMap [Input] introspectInputs (Proxy args forall k (t :: k). Proxy t -Proxy @args) +Proxy @args) -class IntrospectReturn (r :: Return Symbol (TypeRef Symbol)) (isSub :: Bool) where +class IntrospectReturn (r :: Return Symbol (TypeRef Symbol)) (isSub :: Bool) where introspectReturn - :: Proxy r -> Proxy isSub -> Writer TypeMap Type + :: Proxy r -> Proxy isSub -> Writer TypeMap Type -instance IntrospectReturn 'RetNothing isSub where - introspectReturn :: Proxy 'RetNothing -> Proxy isSub -> Writer TypeMap Type -introspectReturn Proxy 'RetNothing +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 @@ -861,10 +861,10 @@ 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) +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). @@ -872,12 +872,12 @@ IntrospectTypeRef tr => Proxy tr -> Bool -> Writer TypeMap Type introspectTypeRef (Proxy t forall k (t :: k). Proxy t -Proxy @t) Bool +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) +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 @@ -888,12 +888,12 @@ IntrospectTypeRef tr => Proxy tr -> Bool -> Writer TypeMap Type introspectTypeRef (Proxy t forall k (t :: k). Proxy t -Proxy @t) Bool +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) +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). @@ -901,16 +901,16 @@ IntrospectTypeRef tr => Proxy tr -> Bool -> Writer TypeMap Type introspectTypeRef (Proxy t forall k (t :: k). Proxy t -Proxy @t) Bool +Proxy @t) Bool True -class IntrospectTypeRef (tr :: TypeRef Symbol) where +class IntrospectTypeRef (tr :: TypeRef Symbol) where introspectTypeRef - :: Proxy tr -> Bool -> Writer TypeMap Type + :: Proxy tr -> Bool -> Writer TypeMap Type instance IntrospectTypeRef ('PrimitiveRef Bool) where - introspectTypeRef :: Proxy ('PrimitiveRef Bool) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Bool) + 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 @@ -923,8 +923,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Boolean" instance IntrospectTypeRef ('PrimitiveRef Int32) where - introspectTypeRef :: Proxy ('PrimitiveRef Int32) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Int32) + 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 @@ -937,8 +937,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Int" instance IntrospectTypeRef ('PrimitiveRef Integer) where - introspectTypeRef :: Proxy ('PrimitiveRef Integer) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Integer) + 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 @@ -951,8 +951,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Int" instance IntrospectTypeRef ('PrimitiveRef Double) where - introspectTypeRef :: Proxy ('PrimitiveRef Double) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Double) + 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 @@ -965,8 +965,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Float" instance IntrospectTypeRef ('PrimitiveRef String) where - introspectTypeRef :: Proxy ('PrimitiveRef String) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef String) + 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 @@ -979,8 +979,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "String" instance IntrospectTypeRef ('PrimitiveRef T.Text) where - introspectTypeRef :: Proxy ('PrimitiveRef Text) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Text) + 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 @@ -993,8 +993,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "String" instance IntrospectTypeRef ('PrimitiveRef JSON.Value) where - introspectTypeRef :: Proxy ('PrimitiveRef Value) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Value) + 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 @@ -1007,8 +1007,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "JSON" instance IntrospectTypeRef ('PrimitiveRef JSON.Object) where - introspectTypeRef :: Proxy ('PrimitiveRef Object) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('PrimitiveRef Object) + 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 @@ -1021,12 +1021,12 @@ forall a b. (a -> b) -> a -> b 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 +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 @@ -1035,23 +1035,23 @@ 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 +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 +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 @@ -1059,14 +1059,14 @@ forall a b. (a -> b) -> a -> b $ Type -> Maybe Type -> Type forall a. a -> Maybe a -> a fromMaybe Type -r (Type -> Maybe Type +r (Type -> Maybe Type unwrapNonNull Type -r) +r) -instance (KnownSymbol o) - => IntrospectTypeRef ('ObjectRef o) where - introspectTypeRef :: Proxy ('ObjectRef o) -> Bool -> Writer TypeMap Type -introspectTypeRef Proxy ('ObjectRef o) +instance (KnownSymbol o) + => IntrospectTypeRef ('ObjectRef o) where + introspectTypeRef :: Proxy ('ObjectRef o) -> Bool -> Writer TypeMap Type +introspectTypeRef Proxy ('ObjectRef o) _ Bool _ = Type -> Writer TypeMap Type @@ -1085,18 +1085,18 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy o forall k (t :: k). Proxy t -Proxy @o) +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 +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 @@ -1106,10 +1106,10 @@ forall (ts :: [TypeDef Symbol Symbol]). IntrospectSchema ts => TypeKind -> Text -> Proxy ts -> Writer TypeMap () introspectSchema TypeKind -k Text -suffix (Proxy sch +k Text +suffix (Proxy sch forall k (t :: k). Proxy t -Proxy @sch) +Proxy @sch) Type -> Writer TypeMap Type forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> Writer TypeMap Type) -> Type -> Writer TypeMap Type @@ -1124,53 +1124,53 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy t forall k (t :: k). Proxy t -Proxy @t)) Text -> Text -> Text +Proxy @t)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -suffix +suffix -class IntrospectSchema (ts :: [Mu.TypeDef Symbol Symbol]) where +class IntrospectSchema (ts :: [Mu.TypeDef Symbol Symbol]) where introspectSchema - :: TypeKind -> T.Text -> Proxy ts -> Writer TypeMap () + :: TypeKind -> T.Text -> Proxy ts -> Writer TypeMap () instance IntrospectSchema '[] where - introspectSchema :: TypeKind -> Text -> Proxy '[] -> Writer TypeMap () -introspectSchema TypeKind + 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 +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) +introspectSchema TypeKind +k Text +suffix Proxy ('DRecord name fields : ts) _ = do - let name :: Text -name = String -> Text + 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 +Proxy @name)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -suffix - fs :: [Field] -fs = Text -> Proxy fields -> [Field] +suffix + fs :: [Field] +fs = Text -> Proxy fields -> [Field] forall (fs :: [FieldDef Symbol Symbol]). IntrospectSchemaFields fs => Text -> Proxy fs -> [Field] introspectSchemaFields Text -suffix (Proxy fields +suffix (Proxy fields forall k (t :: k). Proxy t -Proxy @fields) - t :: Type -t = TypeKind +Proxy @fields) + t :: Type +t = TypeKind -> Maybe Text -> [Field] -> [EnumValue] @@ -1178,11 +1178,11 @@ forall k (t :: k). Proxy t -> Maybe Type -> Type Type TypeKind -k (Text -> Maybe Text +k (Text -> Maybe Text forall a. a -> Maybe a Just Text -name) [Field] -fs [] [] Maybe Type +name) [Field] +fs [] [] Maybe Type forall a. Maybe a Nothing -- add this one to the mix @@ -1191,48 +1191,48 @@ 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) +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 +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 +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) +introspectSchema TypeKind +k Text +suffix Proxy ('DEnum name choices : ts) _ = do - let name :: Text -name = String -> Text + 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 +Proxy @name)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -suffix - cs :: [EnumValue] -cs = Proxy choices -> [EnumValue] +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 +Proxy @choices) + t :: Type +t = TypeKind -> Maybe Text -> [Field] -> [EnumValue] @@ -1243,8 +1243,8 @@ forall k (t :: k). Proxy t ENUM (Text -> Maybe Text forall a. a -> Maybe a Just Text -name) [] [EnumValue] -cs [] Maybe Type +name) [] [EnumValue] +cs [] Maybe Type forall a. Maybe a Nothing -- add this one to the mix @@ -1253,35 +1253,35 @@ 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) +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 +k Text +suffix (Proxy ts forall k (t :: k). Proxy t -Proxy @ts) +Proxy @ts) -class IntrospectSchemaFields (fs :: [Mu.FieldDef Symbol Symbol]) where +class IntrospectSchemaFields (fs :: [Mu.FieldDef Symbol Symbol]) where introspectSchemaFields - :: T.Text -> Proxy fs -> [Field] + :: T.Text -> Proxy fs -> [Field] instance IntrospectSchemaFields '[] where - introspectSchemaFields :: Text -> Proxy '[] -> [Field] -introspectSchemaFields Text + 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) +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 + = let name :: Text +name = String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Proxy fname -> String @@ -1290,40 +1290,40 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy fname forall k (t :: k). Proxy t -Proxy @fname) - ret :: Type -ret = Text -> Proxy r -> Type +Proxy @fname) + ret :: Type +ret = Text -> Proxy r -> Type forall (t :: FieldType Symbol). IntrospectSchemaFieldType t => Text -> Proxy t -> Type introspectSchemaFieldType Text -suffix (Proxy r +suffix (Proxy r forall k (t :: k). Proxy t -Proxy @r) - this :: Field -this = Text -> [Input] -> Type -> Field +Proxy @r) + this :: Field +this = Text -> [Input] -> Type -> Field Field Text -name [] Type -ret +name [] Type +ret in Field -this Field -> [Field] -> [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 +suffix (Proxy fs forall k (t :: k). Proxy t -Proxy @fs) +Proxy @fs) -class IntrospectSchemaFieldType (t :: Mu.FieldType Symbol) where +class IntrospectSchemaFieldType (t :: Mu.FieldType Symbol) where introspectSchemaFieldType - :: T.Text -> Proxy t -> Type + :: T.Text -> Proxy t -> Type instance IntrospectSchemaFieldType ('Mu.TPrimitive Bool) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Bool) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Bool) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Bool) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1332,8 +1332,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Boolean" instance IntrospectSchemaFieldType ('Mu.TPrimitive Int32) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Int32) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Int32) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Int32) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1342,8 +1342,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Int" instance IntrospectSchemaFieldType ('Mu.TPrimitive Integer) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Integer) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Integer) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Integer) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1352,8 +1352,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Int" instance IntrospectSchemaFieldType ('Mu.TPrimitive Double) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Double) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Double) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Double) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1362,8 +1362,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "Float" instance IntrospectSchemaFieldType ('Mu.TPrimitive String) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive String) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive String) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive String) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1372,8 +1372,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "String" instance IntrospectSchemaFieldType ('Mu.TPrimitive T.Text) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Text) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Text) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Text) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1382,8 +1382,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "String" instance IntrospectSchemaFieldType ('Mu.TPrimitive JSON.Value) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Value) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Value) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Value) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1392,8 +1392,8 @@ forall a b. (a -> b) -> a -> b tSimple Text "JSON" instance IntrospectSchemaFieldType ('Mu.TPrimitive JSON.Object) where - introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Object) -> Type -introspectSchemaFieldType Text + introspectSchemaFieldType :: Text -> Proxy ('TPrimitive Object) -> Type +introspectSchemaFieldType Text _ Proxy ('TPrimitive Object) _ = Type -> Type tNonNull (Type -> Type) -> Type -> Type @@ -1402,11 +1402,11 @@ forall a b. (a -> b) -> a -> b tSimple Text "JSONObject" -instance (IntrospectSchemaFieldType r) - => IntrospectSchemaFieldType ('Mu.TList r) where - introspectSchemaFieldType :: Text -> Proxy ('TList r) -> Type -introspectSchemaFieldType Text -suffix Proxy ('TList r) +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 @@ -1416,36 +1416,36 @@ forall (t :: FieldType Symbol). IntrospectSchemaFieldType t => Text -> Proxy t -> Type introspectSchemaFieldType Text -suffix (Proxy r +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) +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 + = let r :: Type +r = Text -> Proxy r -> Type forall (t :: FieldType Symbol). IntrospectSchemaFieldType t => Text -> Proxy t -> Type introspectSchemaFieldType Text -suffix (Proxy r +suffix (Proxy r forall k (t :: k). Proxy t -Proxy @r) +Proxy @r) in Type -> Maybe Type -> Type forall a. a -> Maybe a -> a fromMaybe Type -r (Type -> Maybe Type +r (Type -> Maybe Type unwrapNonNull Type -r) +r) -instance (KnownSymbol nm) - => IntrospectSchemaFieldType ('Mu.TSchematic nm) where - introspectSchemaFieldType :: Text -> Proxy ('TSchematic nm) -> Type -introspectSchemaFieldType Text -suffix Proxy ('TSchematic nm) +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 @@ -1457,24 +1457,24 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy nm forall k (t :: k). Proxy t -Proxy @nm)) Text -> Text -> Text +Proxy @nm)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -suffix +suffix -class IntrospectSchemaEnum (c :: [Mu.ChoiceDef Symbol]) where - introspectSchemaEnum :: Proxy c -> [EnumValue] +class IntrospectSchemaEnum (c :: [Mu.ChoiceDef Symbol]) where + introspectSchemaEnum :: Proxy c -> [EnumValue] instance IntrospectSchemaEnum '[] where - introspectSchemaEnum :: Proxy '[] -> [EnumValue] -introspectSchemaEnum Proxy '[] + 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) +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 + = let this :: EnumValue +this = Text -> EnumValue EnumValue (Text -> EnumValue) -> Text -> EnumValue forall a b. (a -> b) -> a -> b $ String -> Text @@ -1486,9 +1486,9 @@ KnownSymbol n => proxy n -> String symbolVal (Proxy nm forall k (t :: k). Proxy t -Proxy @nm) +Proxy @nm) in EnumValue -this EnumValue -> [EnumValue] -> [EnumValue] +this EnumValue -> [EnumValue] -> [EnumValue] forall a. a -> [a] -> [a] : Proxy cs -> [EnumValue] forall (c :: [ChoiceDef Symbol]). @@ -1496,5 +1496,5 @@ IntrospectSchemaEnum c => Proxy c -> [EnumValue] introspectSchemaEnum (Proxy cs forall k (t :: k). Proxy t -Proxy @cs) +Proxy @cs) \ No newline at end of file diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Parse.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Parse.html index f4732eb..85c3a51 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Parse.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Parse.html @@ -38,56 +38,56 @@ type VariableMap = HM.HashMap T.Text GQL.Value type FragmentMap = HM.HashMap T.Text GQL.FragmentDefinition -instance A.FromJSON GQL.ConstValue where - parseJSON :: Value -> Parser ConstValue +instance A.FromJSON GQL.ConstValue where + parseJSON :: Value -> Parser ConstValue parseJSON Value A.Null = ConstValue -> Parser ConstValue forall (f :: * -> *) a. Applicative f => a -> f a pure ConstValue GQL.ConstNull - parseJSON (A.Bool Bool -b) = ConstValue -> Parser ConstValue + parseJSON (A.Bool Bool +b) = ConstValue -> Parser ConstValue forall (f :: * -> *) a. Applicative f => a -> f a pure (ConstValue -> Parser ConstValue) -> ConstValue -> Parser ConstValue forall a b. (a -> b) -> a -> b $ Bool -> ConstValue GQL.ConstBoolean Bool -b - parseJSON (A.String Text -s) = ConstValue -> Parser ConstValue +b + parseJSON (A.String Text +s) = ConstValue -> Parser ConstValue forall (f :: * -> *) a. Applicative f => a -> f a pure (ConstValue -> Parser ConstValue) -> ConstValue -> Parser ConstValue forall a b. (a -> b) -> a -> b $ Text -> ConstValue GQL.ConstString Text -s - parseJSON (A.Number Scientific -n) = case Scientific -> Either Double Int32 +s + parseJSON (A.Number Scientific +n) = case Scientific -> Either Double Int32 forall r i. (RealFloat r, Integral i) => Scientific -> Either r i floatingOrInteger Scientific -n :: Either Double Int32 of - Right Int32 -i -> ConstValue -> Parser ConstValue +n :: Either Double Int32 of + Right Int32 +i -> ConstValue -> Parser ConstValue forall (f :: * -> *) a. Applicative f => a -> f a pure (ConstValue -> Parser ConstValue) -> ConstValue -> Parser ConstValue forall a b. (a -> b) -> a -> b $ Int32 -> ConstValue GQL.ConstInt Int32 -i - Left Double -m -> ConstValue -> Parser ConstValue +i + Left Double +m -> ConstValue -> Parser ConstValue forall (f :: * -> *) a. Applicative f => a -> f a pure (ConstValue -> Parser ConstValue) -> ConstValue -> Parser ConstValue forall a b. (a -> b) -> a -> b $ Double -> ConstValue GQL.ConstFloat Double -m - parseJSON (A.Array Array -xs) = [Node ConstValue] -> ConstValue +m + parseJSON (A.Array Array +xs) = [Node ConstValue] -> ConstValue GQL.ConstList ([Node ConstValue] -> ConstValue) -> (Vector ConstValue -> [Node ConstValue]) -> Vector ConstValue @@ -119,9 +119,9 @@ forall (t :: * -> *) (f :: * -> *) a b. traverse Value -> Parser ConstValue forall a. FromJSON a => Value -> Parser a A.parseJSON Array -xs - parseJSON (A.Object Object -o) = [ObjectField ConstValue] -> ConstValue +xs + parseJSON (A.Object Object +o) = [ObjectField ConstValue] -> ConstValue GQL.ConstObject ([ObjectField ConstValue] -> ConstValue) -> (HashMap Text ConstValue -> [ObjectField ConstValue]) -> HashMap Text ConstValue @@ -131,7 +131,7 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c -> [(Text, ConstValue)] -> [ObjectField ConstValue] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text, ConstValue) -> ObjectField ConstValue -toObjFld ([(Text, ConstValue)] -> [ObjectField ConstValue]) +toObjFld ([(Text, ConstValue)] -> [ObjectField ConstValue]) -> (HashMap Text ConstValue -> [(Text, ConstValue)]) -> HashMap Text ConstValue -> [ObjectField ConstValue] @@ -149,49 +149,49 @@ forall (t :: * -> *) (f :: * -> *) a b. traverse Value -> Parser ConstValue forall a. FromJSON a => Value -> Parser a A.parseJSON Object -o +o where - toObjFld :: (T.Text, GQL.ConstValue) -> GQL.ObjectField GQL.ConstValue - toObjFld :: (Text, ConstValue) -> ObjectField ConstValue -toObjFld (Text -k, ConstValue -v) = Text -> Node ConstValue -> Location -> ObjectField ConstValue + toObjFld :: (T.Text, GQL.ConstValue) -> GQL.ObjectField GQL.ConstValue + toObjFld :: (Text, ConstValue) -> ObjectField ConstValue +toObjFld (Text +k, ConstValue +v) = Text -> Node ConstValue -> Location -> ObjectField ConstValue forall a. Text -> Node a -> Location -> ObjectField a GQL.ObjectField Text -k (ConstValue -> Location -> Node ConstValue +k (ConstValue -> Location -> Node ConstValue forall a. a -> Location -> Node a GQL.Node ConstValue -v Location -zl) Location -zl - zl :: Location -zl = Word -> Word -> Location +v Location +zl) Location +zl + zl :: Location +zl = Word -> Word -> Location GQL.Location Word 0 Word 0 parseDoc :: - forall qr mut sub p f. - ( MonadError T.Text f, ParseTypedDoc p qr mut sub ) => + forall qr mut sub p f. + ( MonadError T.Text f, ParseTypedDoc p qr mut sub ) => Maybe T.Text -> VariableMapC -> [GQL.Definition] -> - f (Document p qr mut sub) + f (Document p qr mut sub) -- If there's no operation name, there must be only one query parseDoc :: Maybe Text -> HashMap Text ConstValue -> [Definition] -> f (Document p qr mut sub) parseDoc Maybe Text -Nothing HashMap Text ConstValue -vmap [Definition] -defns +Nothing HashMap Text ConstValue +vmap [Definition] +defns = case [Definition] -> ([[Selection]], [OperationDefinition], [FragmentDefinition]) partitionExDefs [Definition] -defns of - ([[Selection] -unnamed], [], [FragmentDefinition] -frs) +defns of + ([[Selection] +unnamed], [], [FragmentDefinition] +frs) -> VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) @@ -203,11 +203,11 @@ VariableMap forall k v. HashMap k v HM.empty ([FragmentDefinition] -> FragmentMap fragmentsToMap [FragmentDefinition] -frs) [Selection] -unnamed - ([], [OperationDefinition -named], [FragmentDefinition] -frs) +frs) [Selection] +unnamed + ([], [OperationDefinition +named], [FragmentDefinition] +frs) -> HashMap Text ConstValue -> FragmentMap -> OperationDefinition -> f (Document p qr mut sub) forall (f :: * -> *) (p :: Package') (qr :: Maybe Symbol) @@ -216,10 +216,10 @@ forall (f :: * -> *) (p :: Package') (qr :: Maybe Symbol) HashMap Text ConstValue -> FragmentMap -> OperationDefinition -> f (Document p qr mut sub) parseTypedDoc HashMap Text ConstValue -vmap ([FragmentDefinition] -> FragmentMap +vmap ([FragmentDefinition] -> FragmentMap fragmentsToMap [FragmentDefinition] -frs) OperationDefinition -named +frs) OperationDefinition +named ([], [], [FragmentDefinition] _) -> Text -> f (Document p qr mut sub) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -245,25 +245,25 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "both named and unnamed queries, but no 'operationName' given" -- If there's an operation name, look in the named queries -parseDoc (Just Text -operationName) HashMap Text ConstValue -vmap [Definition] -defns +parseDoc (Just Text +operationName) HashMap Text ConstValue +vmap [Definition] +defns = case [Definition] -> ([[Selection]], [OperationDefinition], [FragmentDefinition]) partitionExDefs [Definition] -defns of +defns of ([[Selection]] -_, [OperationDefinition] -named, [FragmentDefinition] -frs) -> f (Document p qr mut sub) +_, [OperationDefinition] +named, [FragmentDefinition] +frs) -> f (Document p qr mut sub) -> (OperationDefinition -> f (Document p qr mut sub)) -> Maybe OperationDefinition -> f (Document p qr mut sub) forall b a. b -> (a -> b) -> Maybe a -> b maybe f (Document p qr mut sub) forall a. MonadError Text f => f a -notFound +notFound (HashMap Text ConstValue -> FragmentMap -> OperationDefinition -> f (Document p qr mut sub) forall (f :: * -> *) (p :: Package') (qr :: Maybe Symbol) @@ -272,34 +272,34 @@ forall (f :: * -> *) (p :: Package') (qr :: Maybe Symbol) HashMap Text ConstValue -> FragmentMap -> OperationDefinition -> f (Document p qr mut sub) parseTypedDoc HashMap Text ConstValue -vmap ([FragmentDefinition] -> FragmentMap +vmap ([FragmentDefinition] -> FragmentMap fragmentsToMap [FragmentDefinition] -frs)) +frs)) ((OperationDefinition -> Bool) -> [OperationDefinition] -> Maybe OperationDefinition forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find OperationDefinition -> Bool -isThis [OperationDefinition] -named) - where isThis :: OperationDefinition -> Bool -isThis (GQL.OperationDefinition OperationType -_ (Just Text -nm) [VariableDefinition] +isThis [OperationDefinition] +named) + where isThis :: OperationDefinition -> Bool +isThis (GQL.OperationDefinition OperationType +_ (Just Text +nm) [VariableDefinition] _ [Directive] _ SelectionSet _ Location _) = Text -nm Text -> Text -> Bool +nm Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -operationName - isThis OperationDefinition +operationName + isThis OperationDefinition _ = Bool False - notFound :: MonadError T.Text f => f a - notFound :: f a -notFound = Text -> f a + notFound :: MonadError T.Text f => f a + notFound :: f a +notFound = Text -> f a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f a) -> Text -> f a forall a b. (a -> b) -> a -> b @@ -307,7 +307,7 @@ forall a b. (a -> b) -> a -> b "operation '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -operationName Text -> Text -> Text +operationName Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" @@ -317,32 +317,32 @@ forall a. Semigroup a => a -> a -> a -> ([[GQL.Selection]], [GQL.OperationDefinition], [GQL.FragmentDefinition]) partitionExDefs :: [Definition] -> ([[Selection]], [OperationDefinition], [FragmentDefinition]) -partitionExDefs [Definition] -defs +partitionExDefs [Definition] +defs = ( [ SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList SelectionSet -ss - | GQL.ExecutableDefinition (GQL.DefinitionOperation (GQL.SelectionSet SelectionSet -ss Location +ss + | GQL.ExecutableDefinition (GQL.DefinitionOperation (GQL.SelectionSet SelectionSet +ss Location _)) <- [Definition] -defs ] +defs ] , [ OperationDefinition -od - | GQL.ExecutableDefinition (GQL.DefinitionOperation od :: OperationDefinition -od@GQL.OperationDefinition {}) <- [Definition] -defs ] +od + | GQL.ExecutableDefinition (GQL.DefinitionOperation od :: OperationDefinition +od@GQL.OperationDefinition {}) <- [Definition] +defs ] , [ FragmentDefinition -fr - | GQL.ExecutableDefinition (GQL.DefinitionFragment FragmentDefinition -fr) <- [Definition] -defs ]) +fr + | GQL.ExecutableDefinition (GQL.DefinitionFragment FragmentDefinition +fr) <- [Definition] +defs ]) -parseTypedDoc :: - (MonadError T.Text f, ParseTypedDoc p qr mut sub) => +parseTypedDoc :: + (MonadError T.Text f, ParseTypedDoc p qr mut sub) => VariableMapC -> FragmentMap -> GQL.OperationDefinition -> - f (Document p qr mut sub) + f (Document p qr mut sub) parseTypedDoc :: HashMap Text ConstValue -> FragmentMap -> OperationDefinition -> f (Document p qr mut sub) parseTypedDoc HashMap Text ConstValue @@ -352,23 +352,23 @@ forall (t :: * -> *) a. Foldable t => t a -> [a] forall a. HasCallStack => [Char] -> a error [Char] "this should have been handled in parseDoc" -parseTypedDoc HashMap Text ConstValue -vmap FragmentMap -frmap (GQL.OperationDefinition OperationType -typ Maybe Text -_ [VariableDefinition] -vdefs [Directive] +parseTypedDoc HashMap Text ConstValue +vmap FragmentMap +frmap (GQL.OperationDefinition OperationType +typ Maybe Text +_ [VariableDefinition] +vdefs [Directive] _ (SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] -F.toList -> [Selection] -ss) Location +F.toList -> [Selection] +ss) Location _) - = let defVmap :: HashMap Text ConstValue -defVmap = [VariableDefinition] -> HashMap Text ConstValue + = let defVmap :: HashMap Text ConstValue +defVmap = [VariableDefinition] -> HashMap Text ConstValue parseVariableMap [VariableDefinition] -vdefs - finalVmap :: VariableMap -finalVmap = ConstValue -> Value +vdefs + finalVmap :: VariableMap +finalVmap = ConstValue -> Value constToValue (ConstValue -> Value) -> HashMap Text ConstValue -> VariableMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> HashMap Text ConstValue @@ -377,10 +377,10 @@ forall k v. (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v HM.union HashMap Text ConstValue -vmap HashMap Text ConstValue -defVmap -- first one takes precedence +vmap HashMap Text ConstValue +defVmap -- first one takes precedence in case OperationType -typ of +typ of OperationType GQL.Query -> VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) @@ -390,9 +390,9 @@ forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) parseTypedDocQuery VariableMap -finalVmap FragmentMap -frmap [Selection] -ss +finalVmap FragmentMap +frmap [Selection] +ss OperationType GQL.Mutation -> VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) @@ -402,9 +402,9 @@ forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) parseTypedDocMutation VariableMap -finalVmap FragmentMap -frmap [Selection] -ss +finalVmap FragmentMap +frmap [Selection] +ss OperationType GQL.Subscription -> VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) @@ -414,9 +414,9 @@ forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) VariableMap -> FragmentMap -> [Selection] -> f (Document p qr mut sub) parseTypedDocSubscription VariableMap -finalVmap FragmentMap -frmap [Selection] -ss +finalVmap FragmentMap +frmap [Selection] +ss fragmentsToMap :: [GQL.FragmentDefinition] -> FragmentMap fragmentsToMap :: [FragmentDefinition] -> FragmentMap @@ -431,50 +431,50 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c -> [FragmentDefinition] -> [(Text, FragmentDefinition)] forall a b. (a -> b) -> [a] -> [b] map FragmentDefinition -> (Text, FragmentDefinition) -fragmentToThingy - where fragmentToThingy :: GQL.FragmentDefinition -> (T.Text, GQL.FragmentDefinition) - fragmentToThingy :: FragmentDefinition -> (Text, FragmentDefinition) -fragmentToThingy FragmentDefinition -f = (FragmentDefinition -> Text +fragmentToThingy + where fragmentToThingy :: GQL.FragmentDefinition -> (T.Text, GQL.FragmentDefinition) + fragmentToThingy :: FragmentDefinition -> (Text, FragmentDefinition) +fragmentToThingy FragmentDefinition +f = (FragmentDefinition -> Text fdName FragmentDefinition -f, FragmentDefinition -f) +f, FragmentDefinition +f) -class ParseTypedDoc (p :: Package') - (qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol) where - parseTypedDocQuery :: - MonadError T.Text f => +class ParseTypedDoc (p :: Package') + (qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol) where + parseTypedDocQuery :: + MonadError T.Text f => VariableMap -> FragmentMap -> [GQL.Selection] -> - f (Document p qr mut sub) - parseTypedDocMutation :: - MonadError T.Text f => + f (Document p qr mut sub) + parseTypedDocMutation :: + MonadError T.Text f => VariableMap -> FragmentMap -> [GQL.Selection] -> - f (Document p qr mut sub) - parseTypedDocSubscription :: - MonadError T.Text f => + f (Document p qr mut sub) + parseTypedDocSubscription :: + MonadError T.Text f => VariableMap -> FragmentMap -> [GQL.Selection] -> - f (Document p qr mut sub) + f (Document p qr mut sub) -instance - ( p ~ 'Package pname ss, - LookupService ss qr ~ 'Service qr qmethods, - KnownName qr, ParseMethod p ('Service qr qmethods) qmethods, - LookupService ss mut ~ 'Service mut mmethods, - KnownName mut, ParseMethod p ('Service mut mmethods) mmethods, - LookupService ss sub ~ 'Service sub smethods, - KnownName sub, ParseMethod p ('Service sub smethods) smethods - ) => ParseTypedDoc p ('Just qr) ('Just mut) ('Just sub) where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss qr ~ 'Service qr qmethods, + KnownName qr, ParseMethod p ('Service qr qmethods) qmethods, + LookupService ss mut ~ 'Service mut mmethods, + KnownName mut, ParseMethod p ('Service mut mmethods) mmethods, + LookupService ss sub ~ 'Service sub smethods, + KnownName sub, ParseMethod p ('Service sub smethods) smethods + ) => ParseTypedDoc p ('Just qr) ('Just mut) ('Just sub) where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) ('Just mut) ('Just sub)) -parseTypedDocQuery VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocQuery VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss qr) -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub) forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a) @@ -508,20 +508,20 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy qr +Proxy @p) (Proxy qr forall k (t :: k). Proxy t -Proxy @qr) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocMutation :: VariableMap +Proxy @qr) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) ('Just mut) ('Just sub)) -parseTypedDocMutation VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocMutation VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss mut) -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub) forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a) @@ -555,22 +555,22 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy mut +Proxy @p) (Proxy mut forall k (t :: k). Proxy t -Proxy @mut) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocSubscription :: VariableMap +Proxy @mut) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) ('Just mut) ('Just sub)) -parseTypedDocSubscription VariableMap -vmap FragmentMap -frmap [Selection] -sset - = do ServiceQuery ('Package pname ss) ('Service sub smethods) -q <- Proxy p +parseTypedDocSubscription VariableMap +vmap FragmentMap +frmap [Selection] +sset + = do ServiceQuery ('Package pname ss) ('Service sub smethods) +q <- Proxy p -> Proxy sub -> VariableMap -> FragmentMap @@ -589,16 +589,16 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy sub +Proxy @p) (Proxy sub forall k (t :: k). Proxy t -Proxy @sub) VariableMap -vmap FragmentMap -frmap [Selection] -sset +Proxy @sub) VariableMap +vmap FragmentMap +frmap [Selection] +sset case ServiceQuery ('Package pname ss) ('Service sub smethods) -q of - ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) -one] +q of + ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) +one] -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub) -> f (Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)) @@ -620,28 +620,28 @@ OneMethodQuery ('Package pname ss) (LookupService ss sub) -> Document ('Package pname ss) qr mut ('Just sub) SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) OneMethodQuery ('Package pname ss) ('Service nm ms) -one +one ServiceQuery ('Package pname ss) ('Service sub smethods) _ -> Text -> f (Document p ('Just qr) ('Just mut) ('Just sub)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "subscriptions may only have one field" -instance - ( p ~ 'Package pname ss, - LookupService ss qr ~ 'Service qr qmethods, - KnownName qr, ParseMethod p ('Service qr qmethods) qmethods, - LookupService ss mut ~ 'Service mut mmethods, - KnownName mut, ParseMethod p ('Service mut mmethods) mmethods - ) => ParseTypedDoc p ('Just qr) ('Just mut) 'Nothing where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss qr ~ 'Service qr qmethods, + KnownName qr, ParseMethod p ('Service qr qmethods) qmethods, + LookupService ss mut ~ 'Service mut mmethods, + KnownName mut, ParseMethod p ('Service mut mmethods) mmethods + ) => ParseTypedDoc p ('Just qr) ('Just mut) 'Nothing where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) ('Just mut) 'Nothing) -parseTypedDocQuery VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocQuery VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss qr) -> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a) @@ -674,20 +674,20 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy qr +Proxy @p) (Proxy qr forall k (t :: k). Proxy t -Proxy @qr) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocMutation :: VariableMap +Proxy @qr) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) ('Just mut) 'Nothing) -parseTypedDocMutation VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocMutation VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss mut) -> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a) @@ -720,17 +720,17 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy mut +Proxy @p) (Proxy mut forall k (t :: k). Proxy t -Proxy @mut) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocSubscription :: VariableMap +Proxy @mut) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) ('Just mut) 'Nothing) -parseTypedDocSubscription VariableMap +parseTypedDocSubscription VariableMap _ FragmentMap _ [Selection] _ @@ -739,21 +739,21 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no subscriptions are defined in the schema" -instance - ( p ~ 'Package pname ss, - LookupService ss qr ~ 'Service qr qmethods, - KnownName qr, ParseMethod p ('Service qr qmethods) qmethods, - LookupService ss sub ~ 'Service sub smethods, - KnownName sub, ParseMethod p ('Service sub smethods) smethods - ) => ParseTypedDoc p ('Just qr) 'Nothing ('Just sub) where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss qr ~ 'Service qr qmethods, + KnownName qr, ParseMethod p ('Service qr qmethods) qmethods, + LookupService ss sub ~ 'Service sub smethods, + KnownName sub, ParseMethod p ('Service sub smethods) smethods + ) => ParseTypedDoc p ('Just qr) 'Nothing ('Just sub) where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) 'Nothing ('Just sub)) -parseTypedDocQuery VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocQuery VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss qr) -> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub) forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a) @@ -786,17 +786,17 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy qr +Proxy @p) (Proxy qr forall k (t :: k). Proxy t -Proxy @qr) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocMutation :: VariableMap +Proxy @qr) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) 'Nothing ('Just sub)) -parseTypedDocMutation VariableMap +parseTypedDocMutation VariableMap _ FragmentMap _ [Selection] _ @@ -804,16 +804,16 @@ forall k (t :: k). Proxy t forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no mutations are defined in the schema" - parseTypedDocSubscription :: VariableMap + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) 'Nothing ('Just sub)) -parseTypedDocSubscription VariableMap -vmap FragmentMap -frmap [Selection] -sset - = do ServiceQuery ('Package pname ss) ('Service sub smethods) -q <- Proxy p +parseTypedDocSubscription VariableMap +vmap FragmentMap +frmap [Selection] +sset + = do ServiceQuery ('Package pname ss) ('Service sub smethods) +q <- Proxy p -> Proxy sub -> VariableMap -> FragmentMap @@ -832,16 +832,16 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy sub +Proxy @p) (Proxy sub forall k (t :: k). Proxy t -Proxy @sub) VariableMap -vmap FragmentMap -frmap [Selection] -sset +Proxy @sub) VariableMap +vmap FragmentMap +frmap [Selection] +sset case ServiceQuery ('Package pname ss) ('Service sub smethods) -q of - ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) -one] +q of + ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) +one] -> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub) -> f (Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -861,26 +861,26 @@ OneMethodQuery ('Package pname ss) (LookupService ss sub) -> Document ('Package pname ss) qr mut ('Just sub) SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) OneMethodQuery ('Package pname ss) ('Service nm ms) -one +one ServiceQuery ('Package pname ss) ('Service sub smethods) _ -> Text -> f (Document p ('Just qr) 'Nothing ('Just sub)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "subscriptions may only have one field" -instance - ( p ~ 'Package pname ss, - LookupService ss qr ~ 'Service qr qmethods, - KnownName qr, ParseMethod p ('Service qr qmethods) qmethods - ) => ParseTypedDoc p ('Just qr) 'Nothing 'Nothing where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss qr ~ 'Service qr qmethods, + KnownName qr, ParseMethod p ('Service qr qmethods) qmethods + ) => ParseTypedDoc p ('Just qr) 'Nothing 'Nothing where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) 'Nothing 'Nothing) -parseTypedDocQuery VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocQuery VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss qr) -> Document ('Package pname ss) ('Just qr) 'Nothing 'Nothing forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a) @@ -913,17 +913,17 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy qr +Proxy @p) (Proxy qr forall k (t :: k). Proxy t -Proxy @qr) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocMutation :: VariableMap +Proxy @qr) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) 'Nothing 'Nothing) -parseTypedDocMutation VariableMap +parseTypedDocMutation VariableMap _ FragmentMap _ [Selection] _ @@ -931,11 +931,11 @@ forall k (t :: k). Proxy t forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no mutations are defined in the schema" - parseTypedDocSubscription :: VariableMap + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p ('Just qr) 'Nothing 'Nothing) -parseTypedDocSubscription VariableMap +parseTypedDocSubscription VariableMap _ FragmentMap _ [Selection] _ @@ -944,18 +944,18 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no subscriptions are defined in the schema" -instance - ( p ~ 'Package pname ss, - LookupService ss mut ~ 'Service mut mmethods, - KnownName mut, ParseMethod p ('Service mut mmethods) mmethods, - LookupService ss sub ~ 'Service sub smethods, - KnownName sub, ParseMethod p ('Service sub smethods) smethods - ) => ParseTypedDoc p 'Nothing ('Just mut) ('Just sub) where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss mut ~ 'Service mut mmethods, + KnownName mut, ParseMethod p ('Service mut mmethods) mmethods, + LookupService ss sub ~ 'Service sub smethods, + KnownName sub, ParseMethod p ('Service sub smethods) smethods + ) => ParseTypedDoc p 'Nothing ('Just mut) ('Just sub) where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing ('Just mut) ('Just sub)) -parseTypedDocQuery VariableMap +parseTypedDocQuery VariableMap _ FragmentMap _ [Selection] _ @@ -963,14 +963,14 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no queries are defined in the schema" - parseTypedDocMutation :: VariableMap + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing ('Just mut) ('Just sub)) -parseTypedDocMutation VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocMutation VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss mut) -> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub) forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a) @@ -1004,22 +1004,22 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy mut +Proxy @p) (Proxy mut forall k (t :: k). Proxy t -Proxy @mut) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocSubscription :: VariableMap +Proxy @mut) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing ('Just mut) ('Just sub)) -parseTypedDocSubscription VariableMap -vmap FragmentMap -frmap [Selection] -sset - = do ServiceQuery ('Package pname ss) ('Service sub smethods) -q <- Proxy p +parseTypedDocSubscription VariableMap +vmap FragmentMap +frmap [Selection] +sset + = do ServiceQuery ('Package pname ss) ('Service sub smethods) +q <- Proxy p -> Proxy sub -> VariableMap -> FragmentMap @@ -1038,16 +1038,16 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy sub +Proxy @p) (Proxy sub forall k (t :: k). Proxy t -Proxy @sub) VariableMap -vmap FragmentMap -frmap [Selection] -sset +Proxy @sub) VariableMap +vmap FragmentMap +frmap [Selection] +sset case ServiceQuery ('Package pname ss) ('Service sub smethods) -q of - ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) -one] +q of + ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) +one] -> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub) -> f (Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)) @@ -1069,23 +1069,23 @@ OneMethodQuery ('Package pname ss) (LookupService ss sub) -> Document ('Package pname ss) qr mut ('Just sub) SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) OneMethodQuery ('Package pname ss) ('Service nm ms) -one +one ServiceQuery ('Package pname ss) ('Service sub smethods) _ -> Text -> f (Document p 'Nothing ('Just mut) ('Just sub)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "subscriptions may only have one field" -instance - ( p ~ 'Package pname ss, - LookupService ss mut ~ 'Service mut mmethods, - KnownName mut, ParseMethod p ('Service mut mmethods) mmethods - ) => ParseTypedDoc p 'Nothing ('Just mut) 'Nothing where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss mut ~ 'Service mut mmethods, + KnownName mut, ParseMethod p ('Service mut mmethods) mmethods + ) => ParseTypedDoc p 'Nothing ('Just mut) 'Nothing where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing ('Just mut) 'Nothing) -parseTypedDocQuery VariableMap +parseTypedDocQuery VariableMap _ FragmentMap _ [Selection] _ @@ -1093,14 +1093,14 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no queries are defined in the schema" - parseTypedDocMutation :: VariableMap + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing ('Just mut) 'Nothing) -parseTypedDocMutation VariableMap -vmap FragmentMap -frmap [Selection] -sset +parseTypedDocMutation VariableMap +vmap FragmentMap +frmap [Selection] +sset = ServiceQuery ('Package pname ss) (LookupService ss mut) -> Document ('Package pname ss) 'Nothing ('Just mut) 'Nothing forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a) @@ -1133,17 +1133,17 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy mut +Proxy @p) (Proxy mut forall k (t :: k). Proxy t -Proxy @mut) VariableMap -vmap FragmentMap -frmap [Selection] -sset - parseTypedDocSubscription :: VariableMap +Proxy @mut) VariableMap +vmap FragmentMap +frmap [Selection] +sset + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing ('Just mut) 'Nothing) -parseTypedDocSubscription VariableMap +parseTypedDocSubscription VariableMap _ FragmentMap _ [Selection] _ @@ -1152,16 +1152,16 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no subscriptions are defined in the schema" -instance - ( p ~ 'Package pname ss, - LookupService ss sub ~ 'Service sub smethods, - KnownName sub, ParseMethod p ('Service sub smethods) smethods - ) => ParseTypedDoc p 'Nothing 'Nothing ('Just sub) where - parseTypedDocQuery :: VariableMap +instance + ( p ~ 'Package pname ss, + LookupService ss sub ~ 'Service sub smethods, + KnownName sub, ParseMethod p ('Service sub smethods) smethods + ) => ParseTypedDoc p 'Nothing 'Nothing ('Just sub) where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing 'Nothing ('Just sub)) -parseTypedDocQuery VariableMap +parseTypedDocQuery VariableMap _ FragmentMap _ [Selection] _ @@ -1169,11 +1169,11 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no queries are defined in the schema" - parseTypedDocMutation :: VariableMap + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing 'Nothing ('Just sub)) -parseTypedDocMutation VariableMap +parseTypedDocMutation VariableMap _ FragmentMap _ [Selection] _ @@ -1181,16 +1181,16 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no mutations are defined in the schema" - parseTypedDocSubscription :: VariableMap + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing 'Nothing ('Just sub)) -parseTypedDocSubscription VariableMap -vmap FragmentMap -frmap [Selection] -sset - = do ServiceQuery ('Package pname ss) ('Service sub smethods) -q <- Proxy p +parseTypedDocSubscription VariableMap +vmap FragmentMap +frmap [Selection] +sset + = do ServiceQuery ('Package pname ss) ('Service sub smethods) +q <- Proxy p -> Proxy sub -> VariableMap -> FragmentMap @@ -1209,16 +1209,16 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy sub +Proxy @p) (Proxy sub forall k (t :: k). Proxy t -Proxy @sub) VariableMap -vmap FragmentMap -frmap [Selection] -sset +Proxy @sub) VariableMap +vmap FragmentMap +frmap [Selection] +sset case ServiceQuery ('Package pname ss) ('Service sub smethods) -q of - ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) -one] +q of + ServiceQuery [OneMethodQuery ('Package pname ss) ('Service nm ms) +one] -> Document ('Package pname ss) 'Nothing 'Nothing ('Just sub) -> f (Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1237,20 +1237,20 @@ OneMethodQuery ('Package pname ss) (LookupService ss sub) -> Document ('Package pname ss) qr mut ('Just sub) SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) OneMethodQuery ('Package pname ss) ('Service nm ms) -one +one ServiceQuery ('Package pname ss) ('Service sub smethods) _ -> Text -> f (Document p 'Nothing 'Nothing ('Just sub)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "subscriptions may only have one field" -instance - ParseTypedDoc p 'Nothing 'Nothing 'Nothing where - parseTypedDocQuery :: VariableMap +instance + ParseTypedDoc p 'Nothing 'Nothing 'Nothing where + parseTypedDocQuery :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing 'Nothing 'Nothing) -parseTypedDocQuery VariableMap +parseTypedDocQuery VariableMap _ FragmentMap _ [Selection] _ @@ -1258,11 +1258,11 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no queries are defined in the schema" - parseTypedDocMutation :: VariableMap + parseTypedDocMutation :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing 'Nothing 'Nothing) -parseTypedDocMutation VariableMap +parseTypedDocMutation VariableMap _ FragmentMap _ [Selection] _ @@ -1270,11 +1270,11 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "no mutations are defined in the schema" - parseTypedDocSubscription :: VariableMap + parseTypedDocSubscription :: VariableMap -> FragmentMap -> [Selection] -> f (Document p 'Nothing 'Nothing 'Nothing) -parseTypedDocSubscription VariableMap +parseTypedDocSubscription VariableMap _ FragmentMap _ [Selection] _ @@ -1285,48 +1285,48 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a parseVariableMap :: [GQL.VariableDefinition] -> VariableMapC parseVariableMap :: [VariableDefinition] -> HashMap Text ConstValue -parseVariableMap [VariableDefinition] -vmap +parseVariableMap [VariableDefinition] +vmap = [(Text, ConstValue)] -> HashMap Text ConstValue forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HM.fromList [(Text -v, ConstValue -def) - | GQL.VariableDefinition Text -v Type -_ (Just (GQL.Node ConstValue -def Location +v, ConstValue +def) + | GQL.VariableDefinition Text +v Type +_ (Just (GQL.Node ConstValue +def Location _)) Location _ <- [VariableDefinition] -vmap] +vmap] constToValue :: GQL.ConstValue -> GQL.Value constToValue :: ConstValue -> Value -constToValue (GQL.ConstInt Int32 -n) = Int32 -> Value +constToValue (GQL.ConstInt Int32 +n) = Int32 -> Value GQL.Int Int32 -n -constToValue (GQL.ConstFloat Double -n) = Double -> Value +n +constToValue (GQL.ConstFloat Double +n) = Double -> Value GQL.Float Double -n -constToValue (GQL.ConstString Text -n) = Text -> Value +n +constToValue (GQL.ConstString Text +n) = Text -> Value GQL.String Text -n -constToValue (GQL.ConstBoolean Bool -n) = Bool -> Value +n +constToValue (GQL.ConstBoolean Bool +n) = Bool -> Value GQL.Boolean Bool -n +n constToValue ConstValue GQL.ConstNull = Value GQL.Null -constToValue (GQL.ConstEnum Text -n) = Text -> Value +constToValue (GQL.ConstEnum Text +n) = Text -> Value GQL.Enum Text -n -constToValue (GQL.ConstList [Node ConstValue] -n) +n +constToValue (GQL.ConstList [Node ConstValue] +n) = [Node Value] -> Value GQL.List ([Node Value] -> Value) -> [Node Value] -> Value forall a b. (a -> b) -> a -> b @@ -1340,58 +1340,58 @@ forall a b c. (a -> b -> c) -> b -> a -> c -> [Node ConstValue] -> [Node Value] forall a b. (a -> b) -> [a] -> [b] map [Node ConstValue] -n ((Node ConstValue -> Node Value) -> [Node Value]) +n ((Node ConstValue -> Node Value) -> [Node Value]) -> (Node ConstValue -> Node Value) -> [Node Value] forall a b. (a -> b) -> a -> b -$ \(GQL.Node ConstValue -x Location -loc) -> Value -> Location -> Node Value +$ \(GQL.Node ConstValue +x Location +loc) -> Value -> Location -> Node Value forall a. a -> Location -> Node a GQL.Node (ConstValue -> Value constToValue ConstValue -x) Location -loc -constToValue (GQL.ConstObject [ObjectField ConstValue] -n) +x) Location +loc +constToValue (GQL.ConstObject [ObjectField ConstValue] +n) = [ObjectField Value] -> Value GQL.Object [ Text -> Node Value -> Location -> ObjectField Value forall a. Text -> Node a -> Location -> ObjectField a GQL.ObjectField Text -a (Value -> Location -> Node Value +a (Value -> Location -> Node Value forall a. a -> Location -> Node a GQL.Node (ConstValue -> Value constToValue ConstValue -v) Location -m) Location -l - | GQL.ObjectField Text -a (GQL.Node ConstValue -v Location -m) Location -l <- [ObjectField ConstValue] -n ] +v) Location +m) Location +l + | GQL.ObjectField Text +a (GQL.Node ConstValue +v Location +m) Location +l <- [ObjectField ConstValue] +n ] -class ParseQuery (p :: Package') (s :: Symbol) where - parseQuery - :: ( MonadError T.Text f, p ~ 'Package pname ss, KnownName s ) - => Proxy p -> Proxy s +class ParseQuery (p :: Package') (s :: Symbol) where + parseQuery + :: ( MonadError T.Text f, p ~ 'Package pname ss, KnownName s ) + => Proxy p -> Proxy s -> VariableMap -> FragmentMap -> [GQL.Selection] - -> f (ServiceQuery p (LookupService ss s)) + -> f (ServiceQuery p (LookupService ss s)) -instance ( p ~ 'Package pname ss - , KnownName s - , ParseQuery' p s (LookupService ss s) ) - => ParseQuery p s where - parseQuery :: Proxy p +instance ( p ~ 'Package pname ss + , KnownName s + , ParseQuery' p s (LookupService ss s) ) + => ParseQuery p s where + parseQuery :: Proxy p -> Proxy s -> VariableMap -> FragmentMap -> [Selection] -> f (ServiceQuery p (LookupService ss s)) -parseQuery Proxy p -pp Proxy s -ps = Proxy p +parseQuery Proxy p +pp Proxy s +ps = Proxy p -> Proxy s -> Proxy (LookupService ss s) -> VariableMap @@ -1412,35 +1412,35 @@ Proxy p -> [Selection] -> f (ServiceQuery p svc) parseQuery' Proxy p -pp Proxy s -ps (Proxy (LookupService ss s) +pp Proxy s +ps (Proxy (LookupService ss s) forall k (t :: k). Proxy t -Proxy @(LookupService ss s)) +Proxy @(LookupService ss s)) -class ParseQuery' (p :: Package') (s :: Symbol) (svc :: Service') where - parseQuery' - :: ( MonadError T.Text f, p ~ 'Package pname ss - , LookupService ss s ~ svc, KnownName s ) - => Proxy p -> Proxy s -> Proxy svc +class ParseQuery' (p :: Package') (s :: Symbol) (svc :: Service') where + parseQuery' + :: ( MonadError T.Text f, p ~ 'Package pname ss + , LookupService ss s ~ svc, KnownName s ) + => Proxy p -> Proxy s -> Proxy svc -> VariableMap -> FragmentMap -> [GQL.Selection] - -> f (ServiceQuery p svc) + -> f (ServiceQuery p svc) -instance (ParseQueryOneOf p elts) - => ParseQuery' p s ('OneOf s elts) where - parseQuery' :: Proxy p +instance (ParseQueryOneOf p elts) + => ParseQuery' p s ('OneOf s elts) where + parseQuery' :: Proxy p -> Proxy s -> Proxy ('OneOf s elts) -> VariableMap -> FragmentMap -> [Selection] -> f (ServiceQuery p ('OneOf s elts)) -parseQuery' Proxy p -pp Proxy s -_ps Proxy ('OneOf s elts) -_ VariableMap -vmap FragmentMap -frmap [Selection] -fs +parseQuery' Proxy p +pp Proxy s +_ps Proxy ('OneOf s elts) +_ VariableMap +vmap FragmentMap +frmap [Selection] +fs = NP (ChosenOneOfQuery p) elts -> ServiceQuery p ('OneOf s elts) forall serviceName mnm anm (p :: Package serviceName mnm anm (TypeRef serviceName)) @@ -1467,28 +1467,28 @@ Proxy p -> [Selection] -> f (NP (ChosenOneOfQuery p) s) parseQueryOneOf Proxy p -pp (Proxy elts +pp (Proxy elts forall k (t :: k). Proxy t -Proxy @elts) VariableMap -vmap FragmentMap -frmap [Selection] -fs +Proxy @elts) VariableMap +vmap FragmentMap +frmap [Selection] +fs -class ParseQueryOneOf (p :: Package') (s :: [Symbol]) where - parseQueryOneOf - :: ( MonadError T.Text f, p ~ 'Package pname ss ) - => Proxy p -> Proxy s +class ParseQueryOneOf (p :: Package') (s :: [Symbol]) where + parseQueryOneOf + :: ( MonadError T.Text f, p ~ 'Package pname ss ) + => Proxy p -> Proxy s -> VariableMap -> FragmentMap -> [GQL.Selection] - -> f (NP (ChosenOneOfQuery p) s) + -> f (NP (ChosenOneOfQuery p) s) -instance ParseQueryOneOf p '[] where - parseQueryOneOf :: Proxy p +instance ParseQueryOneOf p '[] where + parseQueryOneOf :: Proxy p -> Proxy '[] -> VariableMap -> FragmentMap -> [Selection] -> f (NP (ChosenOneOfQuery p) '[]) -parseQueryOneOf Proxy p +parseQueryOneOf Proxy p _ Proxy '[] _ VariableMap _ FragmentMap @@ -1498,27 +1498,27 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure NP (ChosenOneOfQuery p) '[] forall k (a :: k -> *). NP a '[] Nil -instance ( ParseQuery p s, KnownSymbol s - , ParseQueryOneOf p ss) - => ParseQueryOneOf p (s ': ss) where - parseQueryOneOf :: Proxy p +instance ( ParseQuery p s, KnownSymbol s + , ParseQueryOneOf p ss) + => ParseQueryOneOf p (s ': ss) where + parseQueryOneOf :: Proxy p -> Proxy (s : ss) -> VariableMap -> FragmentMap -> [Selection] -> f (NP (ChosenOneOfQuery p) (s : ss)) -parseQueryOneOf Proxy p -pp Proxy (s : ss) -_ps VariableMap -vmap FragmentMap -frmap [Selection] -sel - = do [Selection] -refinedSel <- [Selection] -> f [Selection] -refineSelection [Selection] -sel - ServiceQuery ('Package pname ss) (LookupService ss s) -parsedQ <- Proxy p +parseQueryOneOf Proxy p +pp Proxy (s : ss) +_ps VariableMap +vmap FragmentMap +frmap [Selection] +sel + = do [Selection] +refinedSel <- [Selection] -> f [Selection] +refineSelection [Selection] +sel + ServiceQuery ('Package pname ss) (LookupService ss s) +parsedQ <- Proxy p -> Proxy s -> VariableMap -> FragmentMap @@ -1536,14 +1536,14 @@ Proxy p -> [Selection] -> f (ServiceQuery p (LookupService ss s)) parseQuery Proxy p -pp (Proxy s +pp (Proxy s forall k (t :: k). Proxy t -Proxy @s) VariableMap -vmap FragmentMap -frmap [Selection] -refinedSel - NP (ChosenOneOfQuery p) ss -restQ <- Proxy p +Proxy @s) VariableMap +vmap FragmentMap +frmap [Selection] +refinedSel + NP (ChosenOneOfQuery p) ss +restQ <- Proxy p -> Proxy ss -> VariableMap -> FragmentMap @@ -1560,12 +1560,12 @@ Proxy p -> [Selection] -> f (NP (ChosenOneOfQuery p) s) parseQueryOneOf Proxy p -pp (Proxy ss +pp (Proxy ss forall k (t :: k). Proxy t -Proxy @ss) VariableMap -vmap FragmentMap -frmap [Selection] -sel +Proxy @ss) VariableMap +vmap FragmentMap +frmap [Selection] +sel NP (ChosenOneOfQuery ('Package pname ss)) (s : ss) -> f (NP (ChosenOneOfQuery ('Package pname ss)) (s : ss)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1580,68 +1580,68 @@ Proxy elt -> ChosenOneOfQuery ('Package pname ss) elt ChosenOneOfQuery (Proxy s forall k (t :: k). Proxy t -Proxy @s) ServiceQuery ('Package pname ss) (LookupService ss s) -parsedQ ChosenOneOfQuery ('Package pname ss) s +Proxy @s) ServiceQuery ('Package pname ss) (LookupService ss s) +parsedQ ChosenOneOfQuery ('Package pname ss) s -> NP (ChosenOneOfQuery ('Package pname ss)) ss -> NP (ChosenOneOfQuery ('Package pname ss)) (s : ss) forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NP a xs -> NP a (x : xs) :* NP (ChosenOneOfQuery p) ss NP (ChosenOneOfQuery ('Package pname ss)) ss -restQ) +restQ) where -- refineSelection :: [GQL.Selection] -> f [GQL.Selection] - refineSelection :: [Selection] -> f [Selection] -refineSelection [] = [Selection] -> f [Selection] + refineSelection :: [Selection] -> f [Selection] +refineSelection [] = [Selection] -> f [Selection] forall (f :: * -> *) a. Applicative f => a -> f a pure [] - refineSelection (f :: Selection -f@GQL.FieldSelection {} : [Selection] -rest) + refineSelection (f :: Selection +f@GQL.FieldSelection {} : [Selection] +rest) = (Selection -f Selection -> [Selection] -> [Selection] +f Selection -> [Selection] -> [Selection] forall a. a -> [a] -> [a] :) ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Selection] -> f [Selection] -refineSelection [Selection] -rest - refineSelection (GQL.InlineFragmentSelection (GQL.InlineFragment Maybe Text -ty [Directive] -dirs SelectionSet -innerSs Location -_) : [Selection] -rest) +refineSelection [Selection] +rest + refineSelection (GQL.InlineFragmentSelection (GQL.InlineFragment Maybe Text +ty [Directive] +dirs SelectionSet +innerSs Location +_) : [Selection] +rest) | (Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs +vmap) [Directive] +dirs = [Selection] -> f [Selection] -refineSelection [Selection] -rest +refineSelection [Selection] +rest | Maybe Text Nothing <- Maybe Text -ty +ty = [Selection] -> [Selection] -> [Selection] forall a. [a] -> [a] -> [a] (++) ([Selection] -> [Selection] -> [Selection]) -> f [Selection] -> f ([Selection] -> [Selection]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Selection] -> f [Selection] -refineSelection (SelectionSet -> [Selection] +refineSelection (SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList SelectionSet -innerSs) f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] +innerSs) f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Selection] -> f [Selection] -refineSelection [Selection] -rest - | Just Text -selectedTy <- Maybe Text -ty, Text -selectedTy Text -> Text -> Bool +refineSelection [Selection] +rest + | Just Text +selectedTy <- Maybe Text +ty, Text +selectedTy Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == [Char] -> Text T.pack (Proxy s -> [Char] @@ -1650,64 +1650,64 @@ KnownName a => proxy a -> [Char] nameVal (Proxy s forall k (t :: k). Proxy t -Proxy @s)) +Proxy @s)) = [Selection] -> [Selection] -> [Selection] forall a. [a] -> [a] -> [a] (++) ([Selection] -> [Selection] -> [Selection]) -> f [Selection] -> f ([Selection] -> [Selection]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Selection] -> f [Selection] -refineSelection (SelectionSet -> [Selection] +refineSelection (SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList SelectionSet -innerSs) f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] +innerSs) f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Selection] -> f [Selection] -refineSelection [Selection] -rest +refineSelection [Selection] +rest | Bool otherwise = [Selection] -> f [Selection] -refineSelection [Selection] -rest - refineSelection (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text -nm [Directive] -dirs Location -_) : [Selection] -rest) +refineSelection [Selection] +rest + refineSelection (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text +nm [Directive] +dirs Location +_) : [Selection] +rest) | (Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs +vmap) [Directive] +dirs = [Selection] -> f [Selection] -refineSelection [Selection] -rest +refineSelection [Selection] +rest | Just (GQL.FragmentDefinition Text -_ Text -fTy [Directive] -fDirs SelectionSet -fSel Location -fLoc) <- Text -> FragmentMap -> Maybe FragmentDefinition +_ Text +fTy [Directive] +fDirs SelectionSet +fSel Location +fLoc) <- Text -> FragmentMap -> Maybe FragmentDefinition forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -nm FragmentMap -frmap +nm FragmentMap +frmap = [Selection] -> f [Selection] -refineSelection (InlineFragment -> Selection +refineSelection (InlineFragment -> Selection GQL.InlineFragmentSelection (Maybe Text -> [Directive] -> SelectionSet -> Location -> InlineFragment GQL.InlineFragment (Text -> Maybe Text forall a. a -> Maybe a Just Text -fTy) [Directive] -fDirs SelectionSet -fSel Location -fLoc) Selection -> [Selection] -> [Selection] +fTy) [Directive] +fDirs SelectionSet +fSel Location +fLoc) Selection -> [Selection] -> [Selection] forall a. a -> [a] -> [a] : [Selection] -rest) +rest) | Bool otherwise -- the fragment definition was not found = Text -> f [Selection] @@ -1718,28 +1718,28 @@ forall a b. (a -> b) -> a -> b "fragment '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -nm Text -> Text -> Text +nm Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" -instance ( ParseMethod p ('Service s methods) methods, KnownName s ) - => ParseQuery' p s ('Service s methods) where - parseQuery' :: Proxy p +instance ( ParseMethod p ('Service s methods) methods, KnownName s ) + => ParseQuery' p s ('Service s methods) where + parseQuery' :: Proxy p -> Proxy s -> Proxy ('Service s methods) -> VariableMap -> FragmentMap -> [Selection] -> f (ServiceQuery p ('Service s methods)) -parseQuery' Proxy p -_pp Proxy s -_ps Proxy ('Service s methods) -_psvc VariableMap -vmap FragmentMap -frmap [Selection] -fs = [OneMethodQuery p ('Service s methods)] +parseQuery' Proxy p +_pp Proxy s +_ps Proxy ('Service s methods) +_psvc VariableMap +vmap FragmentMap +frmap [Selection] +fs = [OneMethodQuery p ('Service s methods)] -> ServiceQuery p ('Service s methods) forall serviceName methodName argName (p :: Package serviceName methodName argName (TypeRef serviceName)) @@ -1754,17 +1754,17 @@ forall serviceName methodName argName -> f (ServiceQuery p ('Service s methods)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Selection] -> f [OneMethodQuery p ('Service s methods)] -go [Selection] -fs +go [Selection] +fs where - go :: [Selection] -> f [OneMethodQuery p ('Service s methods)] -go [] = [OneMethodQuery p ('Service s methods)] + go :: [Selection] -> f [OneMethodQuery p ('Service s methods)] +go [] = [OneMethodQuery p ('Service s methods)] -> f [OneMethodQuery p ('Service s methods)] forall (f :: * -> *) a. Applicative f => a -> f a pure [] - go (GQL.FieldSelection Field -fld : [Selection] -ss) + go (GQL.FieldSelection Field +fld : [Selection] +ss) = [OneMethodQuery p ('Service s methods)] -> [OneMethodQuery p ('Service s methods)] -> [OneMethodQuery p ('Service s methods)] @@ -1785,53 +1785,53 @@ forall a. Maybe a -> [a] -> f [OneMethodQuery p ('Service s methods)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Field -> f (Maybe (OneMethodQuery p ('Service s methods))) -fieldToMethod Field -fld) f ([OneMethodQuery p ('Service s methods)] +fieldToMethod Field +fld) f ([OneMethodQuery p ('Service s methods)] -> [OneMethodQuery p ('Service s methods)]) -> f [OneMethodQuery p ('Service s methods)] -> f [OneMethodQuery p ('Service s methods)] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Selection] -> f [OneMethodQuery p ('Service s methods)] -go [Selection] -ss - go (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text -nm [Directive] -dirs Location -_) : [Selection] -ss) +go [Selection] +ss + go (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text +nm [Directive] +dirs Location +_) : [Selection] +ss) | (Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs +vmap) [Directive] +dirs = [Selection] -> f [OneMethodQuery p ('Service s methods)] -go [Selection] -ss +go [Selection] +ss | Just (GQL.FragmentDefinition Text -_ Text -fTy [Directive] -fDirs SelectionSet -fSel Location -fLoc) <- Text -> FragmentMap -> Maybe FragmentDefinition +_ Text +fTy [Directive] +fDirs SelectionSet +fSel Location +fLoc) <- Text -> FragmentMap -> Maybe FragmentDefinition forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -nm FragmentMap -frmap +nm FragmentMap +frmap = [Selection] -> f [OneMethodQuery p ('Service s methods)] -go (InlineFragment -> Selection +go (InlineFragment -> Selection GQL.InlineFragmentSelection (Maybe Text -> [Directive] -> SelectionSet -> Location -> InlineFragment GQL.InlineFragment (Text -> Maybe Text forall a. a -> Maybe a Just Text -fTy) [Directive] -fDirs SelectionSet -fSel Location -fLoc) Selection -> [Selection] -> [Selection] +fTy) [Directive] +fDirs SelectionSet +fSel Location +fLoc) Selection -> [Selection] -> [Selection] forall a. a -> [a] -> [a] : [Selection] -ss) +ss) | Bool otherwise -- the fragment definition was not found = Text -> f [OneMethodQuery p ('Service s methods)] @@ -1843,61 +1843,61 @@ forall a b. (a -> b) -> a -> b "fragment '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -nm Text -> Text -> Text +nm Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" - go (GQL.InlineFragmentSelection (GQL.InlineFragment Maybe Text -ty [Directive] -dirs SelectionSet -innerSs Location -_) : [Selection] -ss) + go (GQL.InlineFragmentSelection (GQL.InlineFragment Maybe Text +ty [Directive] +dirs SelectionSet +innerSs Location +_) : [Selection] +ss) | (Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs +vmap) [Directive] +dirs = [Selection] -> f [OneMethodQuery p ('Service s methods)] -go [Selection] -ss +go [Selection] +ss | Maybe Text Nothing <- Maybe Text -ty +ty = [Selection] -> f [OneMethodQuery p ('Service s methods)] -go (SelectionSet -> [Selection] +go (SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList SelectionSet -innerSs [Selection] -> [Selection] -> [Selection] +innerSs [Selection] -> [Selection] -> [Selection] forall a. [a] -> [a] -> [a] ++ [Selection] -ss) - | Just Text -selectedTy <- Maybe Text -ty - = let thisTy :: Text -thisTy = [Char] -> Text +ss) + | Just Text +selectedTy <- Maybe Text +ty + = let thisTy :: Text +thisTy = [Char] -> Text T.pack (Proxy s -> [Char] forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> [Char] nameVal (Proxy s forall k (t :: k). Proxy t -Proxy @s)) +Proxy @s)) in if Text -selectedTy Text -> Text -> Bool +selectedTy Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -thisTy +thisTy then [Selection] -> f [OneMethodQuery p ('Service s methods)] -go (SelectionSet -> [Selection] +go (SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList SelectionSet -innerSs [Selection] -> [Selection] -> [Selection] +innerSs [Selection] -> [Selection] -> [Selection] forall a. [a] -> [a] -> [a] ++ [Selection] -ss) +ss) else Text -> f [OneMethodQuery p ('Service s methods)] forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f [OneMethodQuery p ('Service s methods)]) @@ -1907,32 +1907,32 @@ forall a b. (a -> b) -> a -> b "fragment for '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -selectedTy Text -> Text -> Text +selectedTy Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' used in '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -thisTy Text -> Text -> Text +thisTy Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'" -- fieldToMethod :: GQL.Field -> f (Maybe (OneMethodQuery p ('Service sname methods))) - fieldToMethod :: Field -> f (Maybe (OneMethodQuery p ('Service s methods))) -fieldToMethod f :: Field -f@(GQL.Field Maybe Text -alias Text -name [Argument] -args [Directive] -dirs [Selection] -sels Location + fieldToMethod :: Field -> f (Maybe (OneMethodQuery p ('Service s methods))) +fieldToMethod f :: Field +f@(GQL.Field Maybe Text +alias Text +name [Argument] +args [Directive] +dirs [Selection] +sels Location _) | (Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs +vmap) [Directive] +dirs = Maybe (OneMethodQuery p ('Service s methods)) -> f (Maybe (OneMethodQuery p ('Service s methods))) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1940,13 +1940,13 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a. Maybe a Nothing | Text -name Text -> Text -> Bool +name Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "__typename" = case ([Argument] -args, [Selection] -sels) of +args, [Selection] +sels) of ([], []) -> Maybe (OneMethodQuery p ('Service s methods)) -> f (Maybe (OneMethodQuery p ('Service s methods))) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1968,19 +1968,19 @@ forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (s :: Service snm mnm anm (TypeRef snm)). Maybe Text -> OneMethodQuery p s TypeNameQuery Maybe Text -alias +alias ([Argument], [Selection]) _ -> Text -> f (Maybe (OneMethodQuery p ('Service s methods))) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "__typename does not admit arguments nor selection of subfields" | Text -name Text -> Text -> Bool +name Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "__schema" = case [Argument] -args of +args of [] -> OneMethodQuery p ('Service s methods) -> Maybe (OneMethodQuery p ('Service s methods)) forall a. a -> Maybe a @@ -1995,7 +1995,7 @@ forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (s :: Service snm mnm anm (TypeRef snm)). Maybe Text -> [Selection] -> OneMethodQuery p s SchemaQuery Maybe Text -alias ([Selection] -> Maybe (OneMethodQuery p ('Service s methods))) +alias ([Selection] -> Maybe (OneMethodQuery p ('Service s methods))) -> f [Selection] -> f (Maybe (OneMethodQuery p ('Service s methods))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -2004,51 +2004,51 @@ forall (f :: * -> *). MonadError Text f => FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap -frmap ([Selection] -> [Selection] +frmap ([Selection] -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList [Selection] -sels) +sels) [Argument] _ -> Text -> f (Maybe (OneMethodQuery p ('Service s methods))) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "__schema does not admit selection of subfields" | Text -name Text -> Text -> Bool +name Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "__type" - = let getString :: Value -> Maybe Text -getString (GQL.String Text -s) = Text -> Maybe Text + = let getString :: Value -> Maybe Text +getString (GQL.String Text +s) = Text -> Maybe Text forall a. a -> Maybe a Just Text -s - getString (GQL.Variable Text -v) = Text -> VariableMap -> Maybe Value +s + getString (GQL.Variable Text +v) = Text -> VariableMap -> Maybe Value forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -v VariableMap -vmap Maybe Value -> (Value -> Maybe Text) -> Maybe Text +v VariableMap +vmap Maybe Value -> (Value -> Maybe Text) -> Maybe Text forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Value -> Maybe Text -getString - getString Value +getString + getString Value _ = Maybe Text forall a. Maybe a Nothing in case [Argument] -args of +args of [GQL.Argument Text -_ (GQL.Node Value -val Location +_ (GQL.Node Value +val Location _) Location _] -> case Value -> Maybe Text -getString Value -val of - Just Text -s -> OneMethodQuery p ('Service s methods) +getString Value +val of + Just Text +s -> OneMethodQuery p ('Service s methods) -> Maybe (OneMethodQuery p ('Service s methods)) forall a. a -> Maybe a Just (OneMethodQuery p ('Service s methods) @@ -2063,8 +2063,8 @@ forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (s :: Service snm mnm anm (TypeRef snm)). Maybe Text -> Text -> [Selection] -> OneMethodQuery p s TypeQuery Maybe Text -alias Text -s ([Selection] -> Maybe (OneMethodQuery p ('Service s methods))) +alias Text +s ([Selection] -> Maybe (OneMethodQuery p ('Service s methods))) -> f [Selection] -> f (Maybe (OneMethodQuery p ('Service s methods))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -2073,8 +2073,8 @@ forall (f :: * -> *). MonadError Text f => FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap -frmap [Selection] -sels +frmap [Selection] +sels Maybe Text _ -> Text -> f (Maybe (OneMethodQuery p ('Service s methods))) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -2108,7 +2108,7 @@ forall serviceName methodName argName Maybe Text -> NS (ChosenMethodQuery p) ms -> OneMethodQuery p ('Service nm ms) OneMethodQuery Maybe Text -alias +alias (NS (ChosenMethodQuery p) methods -> Maybe (OneMethodQuery p ('Service s methods))) -> f (NS (ChosenMethodQuery p) methods) @@ -2133,7 +2133,7 @@ Proxy s -> f (NS (ChosenMethodQuery p) ms) selectMethod (Proxy ('Service s methods) forall k (t :: k). Proxy t -Proxy @('Service s methods)) +Proxy @('Service s methods)) ([Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b @@ -2143,28 +2143,28 @@ KnownName a => proxy a -> [Char] nameVal (Proxy s forall k (t :: k). Proxy t -Proxy @s)) +Proxy @s)) VariableMap -vmap FragmentMap -frmap Field -f +vmap FragmentMap +frmap Field +f shouldSkip :: VariableMap -> GQL.Directive -> Bool shouldSkip :: VariableMap -> Directive -> Bool -shouldSkip VariableMap -vmap (GQL.Directive Text -nm [GQL.Argument Text -ifn (GQL.Node Value -v Location +shouldSkip VariableMap +vmap (GQL.Directive Text +nm [GQL.Argument Text +ifn (GQL.Node Value +v Location _) Location _] Location _) | Text -nm Text -> Text -> Bool +nm Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "skip", Text -ifn Text -> Text -> Bool +ifn Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "if" @@ -2174,22 +2174,22 @@ forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser' @'[] @('TPrimitive Bool) VariableMap -vmap Text +vmap Text "" Value -v of - Right (FPrimitive t1 -b) -> t1 +v of + Right (FPrimitive t1 +b) -> t1 Bool -b +b Either Text (FieldValue '[] ('TPrimitive Bool)) _ -> Bool False | Text -nm Text -> Text -> Bool +nm Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "include", Text -ifn Text -> Text -> Bool +ifn Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "if" @@ -2199,14 +2199,14 @@ forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser' @'[] @('TPrimitive Bool) VariableMap -vmap Text +vmap Text "" Value -v of - Right (FPrimitive t1 -b) -> Bool -> Bool +v of + Right (FPrimitive t1 +b) -> Bool -> Bool not t1 Bool -b +b Either Text (FieldValue '[] ('TPrimitive Bool)) _ -> Bool False @@ -2215,25 +2215,25 @@ Bool _ = Bool False -unFragment :: MonadError T.Text f - => FragmentMap -> [GQL.Selection] -> f [GQL.Selection] +unFragment :: MonadError T.Text f + => FragmentMap -> [GQL.Selection] -> f [GQL.Selection] unFragment :: FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap _ [] = [Selection] -> f [Selection] forall (f :: * -> *) a. Applicative f => a -> f a pure [] -unFragment FragmentMap -frmap (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text -nm [Directive] +unFragment FragmentMap +frmap (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text +nm [Directive] _ Location -_) : [Selection] -ss) - | Just FragmentDefinition -fr <- Text -> FragmentMap -> Maybe FragmentDefinition +_) : [Selection] +ss) + | Just FragmentDefinition +fr <- Text -> FragmentMap -> Maybe FragmentDefinition forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -nm FragmentMap -frmap +nm FragmentMap +frmap = [Selection] -> [Selection] -> [Selection] forall a. [a] -> [a] -> [a] (++) ([Selection] -> [Selection] -> [Selection]) @@ -2244,9 +2244,9 @@ forall (f :: * -> *). MonadError Text f => FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap -frmap (FragmentDefinition -> [Selection] +frmap (FragmentDefinition -> [Selection] fdSelectionSet FragmentDefinition -fr) +fr) f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> FragmentMap -> [Selection] -> f [Selection] @@ -2254,8 +2254,8 @@ forall (f :: * -> *). MonadError Text f => FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap -frmap [Selection] -ss +frmap [Selection] +ss | Bool otherwise -- the fragment definition was not found = Text -> f [Selection] @@ -2266,19 +2266,19 @@ forall a b. (a -> b) -> a -> b "fragment '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -nm Text -> Text -> Text +nm Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" -unFragment FragmentMap -frmap (GQL.FieldSelection (GQL.Field Maybe Text -al Text -nm [Argument] -args [Directive] -dir [Selection] -innerss Location -loc) : [Selection] -ss) +unFragment FragmentMap +frmap (GQL.FieldSelection (GQL.Field Maybe Text +al Text +nm [Argument] +args [Directive] +dir [Selection] +innerss Location +loc) : [Selection] +ss) = (:) (Selection -> [Selection] -> [Selection]) -> f Selection -> f ([Selection] -> [Selection]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -2297,11 +2297,11 @@ forall a b c. (a -> b -> c) -> b -> a -> c -> Location -> Field GQL.Field Maybe Text -al Text -nm [Argument] -args [Directive] -dir) Location -loc +al Text +nm [Argument] +args [Directive] +dir) Location +loc ([Selection] -> Selection) -> f [Selection] -> f Selection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FragmentMap -> [Selection] -> f [Selection] @@ -2309,8 +2309,8 @@ forall (f :: * -> *). MonadError Text f => FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap -frmap [Selection] -innerss) +frmap [Selection] +innerss) f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> FragmentMap -> [Selection] -> f [Selection] @@ -2318,8 +2318,8 @@ forall (f :: * -> *). MonadError Text f => FragmentMap -> [Selection] -> f [Selection] unFragment FragmentMap -frmap [Selection] -ss +frmap [Selection] +ss unFragment FragmentMap _ [Selection] _ @@ -2328,10 +2328,10 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "inline fragments are not (yet) supported" -class ParseMethod (p :: Package') (s :: Service') (ms :: [Method']) where - selectMethod :: - MonadError T.Text f => - Proxy s -> +class ParseMethod (p :: Package') (s :: Service') (ms :: [Method']) where + selectMethod :: + MonadError T.Text f => + Proxy s -> T.Text -> VariableMap -> FragmentMap -> @@ -2339,22 +2339,22 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a {- GQL.Name -> [GQL.Argument] -> GQL.SelectionSet -> -} - f (NS (ChosenMethodQuery p) ms) + f (NS (ChosenMethodQuery p) ms) -instance ParseMethod p s '[] where - selectMethod :: Proxy s +instance ParseMethod p s '[] where + selectMethod :: Proxy s -> Text -> VariableMap -> FragmentMap -> Field -> f (NS (ChosenMethodQuery p) '[]) -selectMethod Proxy s -_ Text -tyName VariableMap +selectMethod Proxy s +_ Text +tyName VariableMap _ FragmentMap _ (Field -> Text -fName -> Text -wanted) +fName -> Text +wanted) = Text -> f (NS (ChosenMethodQuery p) '[]) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (NS (ChosenMethodQuery p) '[])) @@ -2364,45 +2364,45 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -wanted Text -> Text -> Text +wanted Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found on type '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -tyName Text -> Text -> Text +tyName Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'" -instance - ( KnownName mname, ParseMethod p s ms - , ParseArgs p s ('Method mname args r) args - , ParseDifferentReturn p r) => - ParseMethod p s ('Method mname args r ': ms) +instance + ( KnownName mname, ParseMethod p s ms + , ParseArgs p s ('Method mname args r) args + , ParseDifferentReturn p r) => + ParseMethod p s ('Method mname args r ': ms) where - selectMethod :: Proxy s + selectMethod :: Proxy s -> Text -> VariableMap -> FragmentMap -> Field -> f (NS (ChosenMethodQuery p) ('Method mname args r : ms)) -selectMethod Proxy s -s Text -tyName VariableMap -vmap FragmentMap -frmap f :: Field -f@(GQL.Field Maybe Text -_ Text -wanted [Argument] -args [Directive] -_ [Selection] -sels Location +selectMethod Proxy s +s Text +tyName VariableMap +vmap FragmentMap +frmap f :: Field +f@(GQL.Field Maybe Text +_ Text +wanted [Argument] +args [Directive] +_ [Selection] +sels Location _) | Text -wanted Text -> Text -> Bool +wanted Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -mname +mname = ChosenMethodQuery p ('Method mname args r) -> NS (ChosenMethodQuery p) ('Method mname args r : ms) forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs) @@ -2424,7 +2424,7 @@ Field -> ReturnQuery p r -> ChosenMethodQuery p ('Method mname args r) ChosenMethodQuery Field -f +f (NP (ArgumentValue p) args -> ReturnQuery p r -> ChosenMethodQuery p ('Method mname args r)) -> f (NP (ArgumentValue p) args) @@ -2448,11 +2448,11 @@ Proxy s -> f (NP (ArgumentValue p) args) parseArgs (Proxy s forall k (t :: k). Proxy t -Proxy @s) (Proxy ('Method mname args r) +Proxy @s) (Proxy ('Method mname args r) forall k (t :: k). Proxy t -Proxy @('Method mname args r)) VariableMap -vmap [Argument] -args +Proxy @('Method mname args r)) VariableMap +vmap [Argument] +args f (ReturnQuery p r -> ChosenMethodQuery p ('Method mname args r)) -> f (ReturnQuery p r) -> f (ChosenMethodQuery p ('Method mname args r)) @@ -2465,10 +2465,10 @@ forall (p :: Package') (r :: Return Symbol (TypeRef Symbol)) VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery p r) parseDiffReturn VariableMap -vmap FragmentMap -frmap Text -wanted [Selection] -sels) +vmap FragmentMap +frmap Text +wanted [Selection] +sels) | Bool otherwise = NS (ChosenMethodQuery p) ms @@ -2498,14 +2498,14 @@ Proxy s -> Field -> f (NS (ChosenMethodQuery p) ms) selectMethod Proxy s -s Text -tyName VariableMap -vmap FragmentMap -frmap Field -f +s Text +tyName VariableMap +vmap FragmentMap +frmap Field +f where - mname :: Text -mname = [Char] -> Text + mname :: Text +mname = [Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy mname -> [Char] @@ -2514,22 +2514,22 @@ KnownName a => proxy a -> [Char] nameVal (Proxy mname forall k (t :: k). Proxy t -Proxy @mname) +Proxy @mname) -class ParseArgs (p :: Package') (s :: Service') (m :: Method') (args :: [Argument']) where - parseArgs :: MonadError T.Text f - => Proxy s -> Proxy m +class ParseArgs (p :: Package') (s :: Service') (m :: Method') (args :: [Argument']) where + parseArgs :: MonadError T.Text f + => Proxy s -> Proxy m -> VariableMap -> [GQL.Argument] - -> f (NP (ArgumentValue p) args) + -> f (NP (ArgumentValue p) args) -instance ParseArgs p s m '[] where - parseArgs :: Proxy s +instance ParseArgs p s m '[] where + parseArgs :: Proxy s -> Proxy m -> VariableMap -> [Argument] -> f (NP (ArgumentValue p) '[]) -parseArgs Proxy s +parseArgs Proxy s _ Proxy m _ VariableMap _ [Argument] @@ -2539,28 +2539,28 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall k (a :: k -> *). NP a '[] Nil -- one single argument without name -instance ParseArg p a - => ParseArgs p s m '[ 'ArgSingle 'Nothing a ] where - parseArgs :: Proxy s +instance ParseArg p a + => ParseArgs p s m '[ 'ArgSingle 'Nothing a ] where + parseArgs :: Proxy s -> Proxy m -> VariableMap -> [Argument] -> f (NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a]) -parseArgs Proxy s +parseArgs Proxy s _ Proxy m -_ VariableMap -vmap [GQL.Argument Text -_ (GQL.Node Value -x Location +_ VariableMap +vmap [GQL.Argument Text +_ (GQL.Node Value +x Location _) Location _] - = (\ArgumentValue' p a -v -> ArgumentValue' p a -> ArgumentValue p ('ArgSingle 'Nothing a) + = (\ArgumentValue' p a +v -> ArgumentValue' p a -> ArgumentValue p ('ArgSingle 'Nothing a) forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (r :: TypeRef snm) (aname :: Maybe anm). ArgumentValue' p r -> ArgumentValue p ('ArgSingle aname r) ArgumentValue ArgumentValue' p a -v ArgumentValue p ('ArgSingle 'Nothing a) +v ArgumentValue p ('ArgSingle 'Nothing a) -> NP (ArgumentValue p) '[] -> NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a] forall k (a :: k -> *) (x :: k) (xs :: [k]). @@ -2577,9 +2577,9 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg' VariableMap -vmap Text +vmap Text "arg" Value -x +x parseArgs Proxy s _ Proxy m _ VariableMap @@ -2589,30 +2589,30 @@ VariableMap -> Text -> Value -> f (ArgumentValue' p a) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "this field receives one single argument" -instance ParseArg p a - => ParseArgs p s m '[ 'ArgStream 'Nothing a ] where - parseArgs :: Proxy s +instance ParseArg p a + => ParseArgs p s m '[ 'ArgStream 'Nothing a ] where + parseArgs :: Proxy s -> Proxy m -> VariableMap -> [Argument] -> f (NP (ArgumentValue p) '[ 'ArgStream 'Nothing a]) -parseArgs Proxy s +parseArgs Proxy s _ Proxy m -_ VariableMap -vmap [GQL.Argument Text -_ (GQL.Node Value -x Location +_ VariableMap +vmap [GQL.Argument Text +_ (GQL.Node Value +x Location _) Location _] - = (\ArgumentValue' p ('ListRef a) -v -> ArgumentValue' p ('ListRef a) + = (\ArgumentValue' p ('ListRef a) +v -> ArgumentValue' p ('ListRef a) -> ArgumentValue p ('ArgStream 'Nothing a) forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (r :: TypeRef snm) (aname :: Maybe anm). ArgumentValue' p ('ListRef r) -> ArgumentValue p ('ArgStream aname r) ArgumentStream ArgumentValue' p ('ListRef a) -v ArgumentValue p ('ArgStream 'Nothing a) +v ArgumentValue p ('ArgStream 'Nothing a) -> NP (ArgumentValue p) '[] -> NP (ArgumentValue p) '[ 'ArgStream 'Nothing a] forall k (a :: k -> *) (x :: k) (xs :: [k]). @@ -2629,9 +2629,9 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg' VariableMap -vmap Text +vmap Text "arg" Value -x +x parseArgs Proxy s _ Proxy m _ VariableMap @@ -2642,23 +2642,23 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "this field receives one single argument" -- more than one argument -instance ( KnownName aname, ParseMaybeArg p a, ParseArgs p s m as - , s ~ 'Service snm sms, m ~ 'Method mnm margs mr - , ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname - , FindDefaultArgValue ann ) - => ParseArgs p s m ('ArgSingle ('Just aname) a ': as) where - parseArgs :: Proxy s +instance ( KnownName aname, ParseMaybeArg p a, ParseArgs p s m as + , s ~ 'Service snm sms, m ~ 'Method mnm margs mr + , ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname + , FindDefaultArgValue ann ) + => ParseArgs p s m ('ArgSingle ('Just aname) a ': as) where + parseArgs :: Proxy s -> Proxy m -> VariableMap -> [Argument] -> f (NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as)) -parseArgs Proxy s -ps Proxy m -pm VariableMap -vmap [Argument] -args - = let aname :: Text -aname = [Char] -> Text +parseArgs Proxy s +ps Proxy m +pm VariableMap +vmap [Argument] +args + = let aname :: Text +aname = [Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy aname -> [Char] @@ -2667,7 +2667,7 @@ KnownName a => proxy a -> [Char] nameVal (Proxy aname forall k (t :: k). Proxy t -Proxy @aname) +Proxy @aname) in case (Argument -> Bool) -> [Argument] -> Maybe Argument forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find (([Char] -> [Char] -> Bool @@ -2678,17 +2678,17 @@ KnownName a => proxy a -> [Char] nameVal (Proxy aname forall k (t :: k). Proxy t -Proxy @aname)) ([Char] -> Bool) -> (Argument -> [Char]) -> Argument -> Bool +Proxy @aname)) ([Char] -> Bool) -> (Argument -> [Char]) -> Argument -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> [Char] T.unpack (Text -> [Char]) -> (Argument -> Text) -> Argument -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . Argument -> Text argName) [Argument] -args of +args of Just (GQL.Argument Text -_ (GQL.Node Value -x Location +_ (GQL.Node Value +x Location _) Location _) -> ArgumentValue p ('ArgSingle ('Just aname) a) @@ -2717,11 +2717,11 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseMaybeArg p a, MonadError Text f) => VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a) parseMaybeArg VariableMap -vmap Text -aname (Value -> Maybe Value +vmap Text +aname (Value -> Maybe Value forall a. a -> Maybe a Just Value -x)) +x)) f (NP (ArgumentValue p) as -> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as)) -> f (NP (ArgumentValue p) as) @@ -2743,20 +2743,20 @@ Proxy s -> [Argument] -> f (NP (ArgumentValue p) args) parseArgs Proxy s -ps Proxy m -pm VariableMap -vmap [Argument] -args +ps Proxy m +pm VariableMap +vmap [Argument] +args Maybe Argument Nothing - -> do let x :: Maybe ConstValue -x = Proxy ann -> Maybe ConstValue + -> do let x :: Maybe ConstValue +x = Proxy ann -> Maybe ConstValue forall (vs :: Maybe DefaultValue). FindDefaultArgValue vs => Proxy vs -> Maybe ConstValue findDefaultArgValue (Proxy ann forall k (t :: k). Proxy t -Proxy @ann) +Proxy @ann) ArgumentValue p ('ArgSingle ('Just aname) a) -> NP (ArgumentValue p) as -> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as) @@ -2783,12 +2783,12 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseMaybeArg p a, MonadError Text f) => VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a) parseMaybeArg VariableMap -vmap Text -aname (ConstValue -> Value +vmap Text +aname (ConstValue -> Value constToValue (ConstValue -> Value) -> Maybe ConstValue -> Maybe Value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe ConstValue -x)) +x)) f (NP (ArgumentValue p) as -> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as)) -> f (NP (ArgumentValue p) as) @@ -2810,27 +2810,27 @@ Proxy s -> [Argument] -> f (NP (ArgumentValue p) args) parseArgs Proxy s -ps Proxy m -pm VariableMap -vmap [Argument] -args -instance ( KnownName aname, ParseArg p a, ParseArgs p s m as - , s ~ 'Service snm sms, m ~ 'Method mnm margs mr - , ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname - , FindDefaultArgValue ann ) - => ParseArgs p s m ('ArgStream ('Just aname) a ': as) where - parseArgs :: Proxy s +ps Proxy m +pm VariableMap +vmap [Argument] +args +instance ( KnownName aname, ParseArg p a, ParseArgs p s m as + , s ~ 'Service snm sms, m ~ 'Method mnm margs mr + , ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname + , FindDefaultArgValue ann ) + => ParseArgs p s m ('ArgStream ('Just aname) a ': as) where + parseArgs :: Proxy s -> Proxy m -> VariableMap -> [Argument] -> f (NP (ArgumentValue p) ('ArgStream ('Just aname) a : as)) -parseArgs Proxy s -ps Proxy m -pm VariableMap -vmap [Argument] -args - = let aname :: Text -aname = [Char] -> Text +parseArgs Proxy s +ps Proxy m +pm VariableMap +vmap [Argument] +args + = let aname :: Text +aname = [Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy aname -> [Char] @@ -2839,7 +2839,7 @@ KnownName a => proxy a -> [Char] nameVal (Proxy aname forall k (t :: k). Proxy t -Proxy @aname) +Proxy @aname) in case (Argument -> Bool) -> [Argument] -> Maybe Argument forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find (([Char] -> [Char] -> Bool @@ -2850,17 +2850,17 @@ KnownName a => proxy a -> [Char] nameVal (Proxy aname forall k (t :: k). Proxy t -Proxy @aname)) ([Char] -> Bool) -> (Argument -> [Char]) -> Argument -> Bool +Proxy @aname)) ([Char] -> Bool) -> (Argument -> [Char]) -> Argument -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> [Char] T.unpack (Text -> [Char]) -> (Argument -> Text) -> Argument -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . Argument -> Text argName) [Argument] -args of +args of Just (GQL.Argument Text -_ (GQL.Node Value -x Location +_ (GQL.Node Value +x Location _) Location _) -> ArgumentValue p ('ArgStream ('Just aname) a) @@ -2892,11 +2892,11 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseMaybeArg p a, MonadError Text f) => VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a) parseMaybeArg VariableMap -vmap Text -aname (Value -> Maybe Value +vmap Text +aname (Value -> Maybe Value forall a. a -> Maybe a Just Value -x)) +x)) f (NP (ArgumentValue p) as -> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as)) -> f (NP (ArgumentValue p) as) @@ -2918,20 +2918,20 @@ Proxy s -> [Argument] -> f (NP (ArgumentValue p) args) parseArgs Proxy s -ps Proxy m -pm VariableMap -vmap [Argument] -args +ps Proxy m +pm VariableMap +vmap [Argument] +args Maybe Argument Nothing - -> do let x :: Maybe ConstValue -x = Proxy ann -> Maybe ConstValue + -> do let x :: Maybe ConstValue +x = Proxy ann -> Maybe ConstValue forall (vs :: Maybe DefaultValue). FindDefaultArgValue vs => Proxy vs -> Maybe ConstValue findDefaultArgValue (Proxy ann forall k (t :: k). Proxy t -Proxy @ann) +Proxy @ann) ArgumentValue p ('ArgStream ('Just aname) a) -> NP (ArgumentValue p) as -> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as) @@ -2961,12 +2961,12 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseMaybeArg p a, MonadError Text f) => VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a) parseMaybeArg VariableMap -vmap Text -aname (ConstValue -> Value +vmap Text +aname (ConstValue -> Value constToValue (ConstValue -> Value) -> Maybe ConstValue -> Maybe Value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe ConstValue -x)) +x)) f (NP (ArgumentValue p) as -> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as)) -> f (NP (ArgumentValue p) as) @@ -2988,24 +2988,24 @@ Proxy s -> [Argument] -> f (NP (ArgumentValue p) args) parseArgs Proxy s -ps Proxy m -pm VariableMap -vmap [Argument] -args +ps Proxy m +pm VariableMap +vmap [Argument] +args -class FindDefaultArgValue (vs :: Maybe DefaultValue) where - findDefaultArgValue :: Proxy vs +class FindDefaultArgValue (vs :: Maybe DefaultValue) where + findDefaultArgValue :: Proxy vs -> Maybe GQL.ConstValue instance FindDefaultArgValue 'Nothing where - findDefaultArgValue :: Proxy 'Nothing -> Maybe ConstValue -findDefaultArgValue Proxy 'Nothing + findDefaultArgValue :: Proxy 'Nothing -> Maybe ConstValue +findDefaultArgValue Proxy 'Nothing _ = Maybe ConstValue forall a. Maybe a Nothing -instance ReflectValueConst v - => FindDefaultArgValue ('Just ('DefaultValue v)) where - findDefaultArgValue :: Proxy ('Just ('DefaultValue v)) -> Maybe ConstValue -findDefaultArgValue Proxy ('Just ('DefaultValue v)) +instance ReflectValueConst v + => FindDefaultArgValue ('Just ('DefaultValue v)) where + findDefaultArgValue :: Proxy ('Just ('DefaultValue v)) -> Maybe ConstValue +findDefaultArgValue Proxy ('Just ('DefaultValue v)) _ = ConstValue -> Maybe ConstValue forall a. a -> Maybe a Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue @@ -3017,23 +3017,23 @@ ReflectValueConst v => proxy v -> ConstValue reflectValueConst (Proxy v forall k (t :: k). Proxy t -Proxy @v) +Proxy @v) -class ParseMaybeArg (p :: Package') (a :: TypeRef Symbol) where - parseMaybeArg :: MonadError T.Text f +class ParseMaybeArg (p :: Package') (a :: TypeRef Symbol) where + parseMaybeArg :: MonadError T.Text f => VariableMap -> T.Text -> Maybe GQL.Value - -> f (ArgumentValue' p a) + -> f (ArgumentValue' p a) -instance {-# OVERLAPS #-} (ParseArg p a) - => ParseMaybeArg p ('OptionalRef a) where - parseMaybeArg :: VariableMap +instance {-# OVERLAPS #-} (ParseArg p a) + => ParseMaybeArg p ('OptionalRef a) where + parseMaybeArg :: VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p ('OptionalRef a)) -parseMaybeArg VariableMap -vmap Text -aname (Just Value -x) +parseMaybeArg VariableMap +vmap Text +aname (Just Value +x) = Maybe (ArgumentValue' p a) -> ArgumentValue' p ('OptionalRef a) forall serviceName mnm anm (p :: Package serviceName mnm anm (TypeRef serviceName)) @@ -3054,9 +3054,9 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg' VariableMap -vmap Text -aname Value -x +vmap Text +aname Value +x parseMaybeArg VariableMap _ Text _ Maybe Value @@ -3077,22 +3077,22 @@ Maybe (ArgumentValue' p r) -> ArgumentValue' p ('OptionalRef r) ArgOptional Maybe (ArgumentValue' p a) forall a. Maybe a Nothing -instance {-# OVERLAPS #-} (ParseArg p a) - => ParseMaybeArg p ('ListRef a) where - parseMaybeArg :: VariableMap +instance {-# OVERLAPS #-} (ParseArg p a) + => ParseMaybeArg p ('ListRef a) where + parseMaybeArg :: VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p ('ListRef a)) -parseMaybeArg VariableMap -vmap Text -aname (Just Value -x) +parseMaybeArg VariableMap +vmap Text +aname (Just Value +x) = VariableMap -> Text -> Value -> f (ArgumentValue' p ('ListRef a)) forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg' VariableMap -vmap Text -aname Value -x +vmap Text +aname Value +x parseMaybeArg VariableMap _ Text _ Maybe Value @@ -3110,24 +3110,24 @@ forall serviceName mnm anm (r :: TypeRef serviceName). [ArgumentValue' p r] -> ArgumentValue' p ('ListRef r) ArgList [] -instance {-# OVERLAPPABLE #-} (ParseArg p a) - => ParseMaybeArg p a where - parseMaybeArg :: VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a) -parseMaybeArg VariableMap -vmap Text -aname (Just Value -x) +instance {-# OVERLAPPABLE #-} (ParseArg p a) + => ParseMaybeArg p a where + parseMaybeArg :: VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a) +parseMaybeArg VariableMap +vmap Text +aname (Just Value +x) = VariableMap -> Text -> Value -> f (ArgumentValue' p a) forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg' VariableMap -vmap Text -aname Value -x +vmap Text +aname Value +x parseMaybeArg VariableMap -_ Text -aname Maybe Value +_ Text +aname Maybe Value Nothing = Text -> f (ArgumentValue' p a) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3137,28 +3137,28 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not given a value, and has no default one" -parseArg' :: (ParseArg p a, MonadError T.Text f) +parseArg' :: (ParseArg p a, MonadError T.Text f) => VariableMap -> T.Text -> GQL.Value - -> f (ArgumentValue' p a) + -> f (ArgumentValue' p a) parseArg' :: VariableMap -> Text -> Value -> f (ArgumentValue' p a) -parseArg' VariableMap -vmap Text -aname (GQL.Variable Text -x) +parseArg' VariableMap +vmap Text +aname (GQL.Variable Text +x) = case Text -> VariableMap -> Maybe Value forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -x VariableMap -vmap of +x VariableMap +vmap of Maybe Value Nothing -> Text -> f (ArgumentValue' p a) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3168,44 +3168,44 @@ forall a b. (a -> b) -> a -> b "variable '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -x Text -> Text -> Text +x Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" - Just Value -v -> VariableMap -> Text -> Value -> f (ArgumentValue' p a) + Just Value +v -> VariableMap -> Text -> Value -> f (ArgumentValue' p a) forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg VariableMap -vmap Text -aname Value -v -parseArg' VariableMap -vmap Text -aname Value -v = VariableMap -> Text -> Value -> f (ArgumentValue' p a) +vmap Text +aname Value +v +parseArg' VariableMap +vmap Text +aname Value +v = VariableMap -> Text -> Value -> f (ArgumentValue' p a) forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg VariableMap -vmap Text -aname Value -v +vmap Text +aname Value +v -class ParseArg (p :: Package') (a :: TypeRef Symbol) where - parseArg :: MonadError T.Text f +class ParseArg (p :: Package') (a :: TypeRef Symbol) where + parseArg :: MonadError T.Text f => VariableMap -> T.Text -> GQL.Value - -> f (ArgumentValue' p a) + -> f (ArgumentValue' p a) -instance (ParseArg p r) => ParseArg p ('ListRef r) where - parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('ListRef r)) -parseArg VariableMap -vmap Text -aname (GQL.List [Node Value] -xs) +instance (ParseArg p r) => ParseArg p ('ListRef r) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('ListRef r)) +parseArg VariableMap +vmap Text +aname (GQL.List [Node Value] +xs) = [ArgumentValue' p r] -> ArgumentValue' p ('ListRef r) forall serviceName mnm anm (p :: Package serviceName mnm anm (TypeRef serviceName)) @@ -3224,17 +3224,17 @@ forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *). (ParseArg p a, MonadError Text f) => VariableMap -> Text -> Value -> f (ArgumentValue' p a) parseArg' VariableMap -vmap Text -aname (Value -> f (ArgumentValue' p r)) +vmap Text +aname (Value -> f (ArgumentValue' p r)) -> (Node Value -> Value) -> Node Value -> f (ArgumentValue' p r) forall b c a. (b -> c) -> (a -> b) -> a -> c . Node Value -> Value forall a. Node a -> a GQL.node) [Node Value] -xs +xs parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('ListRef r)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3245,17 +3245,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef Bool) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef Bool) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Bool)) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.Boolean Bool -b) +_ (GQL.Boolean Bool +b) = ArgumentValue' p ('PrimitiveRef Bool) -> f (ArgumentValue' p ('PrimitiveRef Bool)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3268,10 +3268,10 @@ forall a b. (a -> b) -> a -> b forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)). t -> ArgumentValue' p ('PrimitiveRef t) ArgPrimitive Bool -b +b parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef Bool)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3282,17 +3282,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef Int32) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef Int32) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Int32)) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.Int Int32 -b) +_ (GQL.Int Int32 +b) = ArgumentValue' p ('PrimitiveRef Int32) -> f (ArgumentValue' p ('PrimitiveRef Int32)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3310,10 +3310,10 @@ forall a b. (a -> b) -> a -> b $ Int32 -> Int32 forall a b. (Integral a, Num b) => a -> b fromIntegral Int32 -b +b parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef Int32)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3324,17 +3324,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef Integer) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef Integer) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Integer)) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.Int Int32 -b) +_ (GQL.Int Int32 +b) = ArgumentValue' p ('PrimitiveRef Integer) -> f (ArgumentValue' p ('PrimitiveRef Integer)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3349,10 +3349,10 @@ t -> ArgumentValue' p ('PrimitiveRef t) ArgPrimitive (Int32 -> Integer forall a. Integral a => a -> Integer toInteger Int32 -b) +b) parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef Integer)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3363,17 +3363,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef Scientific) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef Scientific) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Scientific)) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.Float Double -b) +_ (GQL.Float Double +b) = ArgumentValue' p ('PrimitiveRef Scientific) -> f (ArgumentValue' p ('PrimitiveRef Scientific)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3391,10 +3391,10 @@ forall a b. (a -> b) -> a -> b $ Double -> Scientific forall a. RealFloat a => a -> Scientific fromFloatDigits Double -b +b parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef Scientific)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3405,17 +3405,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef Double) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef Double) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Double)) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.Float Double -b) +_ (GQL.Float Double +b) = ArgumentValue' p ('PrimitiveRef Double) -> f (ArgumentValue' p ('PrimitiveRef Double)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3428,10 +3428,10 @@ forall a b. (a -> b) -> a -> b forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)). t -> ArgumentValue' p ('PrimitiveRef t) ArgPrimitive Double -b +b parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef Double)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3442,17 +3442,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef T.Text) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef T.Text) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Text)) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.String Text -b) +_ (GQL.String Text +b) = ArgumentValue' p ('PrimitiveRef Text) -> f (ArgumentValue' p ('PrimitiveRef Text)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3465,10 +3465,10 @@ forall a b. (a -> b) -> a -> b forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)). t -> ArgumentValue' p ('PrimitiveRef t) ArgPrimitive Text -b +b parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef Text)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3479,17 +3479,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef String) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef String) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef [Char])) -parseArg VariableMap +parseArg VariableMap _ Text -_ (GQL.String Text -b) +_ (GQL.String Text +b) = ArgumentValue' p ('PrimitiveRef [Char]) -> f (ArgumentValue' p ('PrimitiveRef [Char])) forall (f :: * -> *) a. Applicative f => a -> f a @@ -3506,10 +3506,10 @@ t -> ArgumentValue' p ('PrimitiveRef t) forall a b. (a -> b) -> a -> b $ Text -> [Char] T.unpack Text -b +b parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef [Char])) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3520,14 +3520,14 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ParseArg p ('PrimitiveRef ()) where - parseArg :: VariableMap +instance ParseArg p ('PrimitiveRef ()) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef ())) -parseArg VariableMap +parseArg VariableMap _ Text _ Value GQL.Null = ArgumentValue' p ('PrimitiveRef ()) @@ -3543,8 +3543,8 @@ forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)). t -> ArgumentValue' p ('PrimitiveRef t) ArgPrimitive () parseArg VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (ArgumentValue' p ('PrimitiveRef ())) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3555,18 +3555,18 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance (ObjectOrEnumParser sch (sch :/: sty)) - => ParseArg p ('SchemaRef sch sty) where - parseArg :: VariableMap +instance (ObjectOrEnumParser sch (sch :/: sty)) + => ParseArg p ('SchemaRef sch sty) where + parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('SchemaRef sch sty)) -parseArg VariableMap -vmap Text -aname Value -v +parseArg VariableMap +vmap Text +aname Value +v = Term sch (sch :/: sty) -> ArgumentValue' p ('SchemaRef sch sty) forall typeName fieldName snm mnm anm (sch :: Schema typeName fieldName) (sty :: typeName) @@ -3582,25 +3582,25 @@ forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol) (ObjectOrEnumParser sch t, MonadError Text f) => VariableMap -> Text -> Value -> f (Term sch t) parseObjectOrEnum' VariableMap -vmap Text -aname Value -v +vmap Text +aname Value +v -parseObjectOrEnum' :: (ObjectOrEnumParser sch t, MonadError T.Text f) +parseObjectOrEnum' :: (ObjectOrEnumParser sch t, MonadError T.Text f) => VariableMap -> T.Text -> GQL.Value - -> f (Term sch t) + -> f (Term sch t) parseObjectOrEnum' :: VariableMap -> Text -> Value -> f (Term sch t) -parseObjectOrEnum' VariableMap -vmap Text -aname (GQL.Variable Text -x) +parseObjectOrEnum' VariableMap +vmap Text +aname (GQL.Variable Text +x) = case Text -> VariableMap -> Maybe Value forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -x VariableMap -vmap of +x VariableMap +vmap of Maybe Value Nothing -> Text -> f (Term sch t) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3610,48 +3610,48 @@ forall a b. (a -> b) -> a -> b "variable '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -x Text -> Text -> Text +x Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" - Just Value -v -> VariableMap -> Text -> Value -> f (Term sch t) + Just Value +v -> VariableMap -> Text -> Value -> f (Term sch t) forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol) (f :: * -> *). (ObjectOrEnumParser sch t, MonadError Text f) => VariableMap -> Text -> Value -> f (Term sch t) parseObjectOrEnum VariableMap -vmap Text -aname Value -v -parseObjectOrEnum' VariableMap -vmap Text -aname Value -v +vmap Text +aname Value +v +parseObjectOrEnum' VariableMap +vmap Text +aname Value +v = VariableMap -> Text -> Value -> f (Term sch t) forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol) (f :: * -> *). (ObjectOrEnumParser sch t, MonadError Text f) => VariableMap -> Text -> Value -> f (Term sch t) parseObjectOrEnum VariableMap -vmap Text -aname Value -v +vmap Text +aname Value +v -class ObjectOrEnumParser (sch :: Schema') (t :: TypeDef Symbol Symbol) where - parseObjectOrEnum :: MonadError T.Text f +class ObjectOrEnumParser (sch :: Schema') (t :: TypeDef Symbol Symbol) where + parseObjectOrEnum :: MonadError T.Text f => VariableMap -> T.Text -> GQL.Value - -> f (Term sch t) + -> f (Term sch t) -instance (ObjectParser sch args, KnownName name) - => ObjectOrEnumParser sch ('DRecord name args) where - parseObjectOrEnum :: VariableMap -> Text -> Value -> f (Term sch ('DRecord name args)) -parseObjectOrEnum VariableMap -vmap Text -_ (GQL.Object [ObjectField Value] -vs) +instance (ObjectParser sch args, KnownName name) + => ObjectOrEnumParser sch ('DRecord name args) where + parseObjectOrEnum :: VariableMap -> Text -> Value -> f (Term sch ('DRecord name args)) +parseObjectOrEnum VariableMap +vmap Text +_ (GQL.Object [ObjectField Value] +vs) = NP (Field sch) args -> Term sch ('DRecord name args) forall typeName fieldName (sch :: Schema typeName fieldName) (args :: [FieldDef typeName fieldName]) (name :: typeName). @@ -3667,7 +3667,7 @@ forall (sch :: Schema') (args :: [FieldDef Symbol Symbol]) VariableMap -> Text -> [ObjectField Value] -> f (NP (Field sch) args) objectParser VariableMap -vmap ([Char] -> Text +vmap ([Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy name -> [Char] @@ -3676,11 +3676,11 @@ KnownName a => proxy a -> [Char] nameVal (Proxy name forall k (t :: k). Proxy t -Proxy @name)) [ObjectField Value] -vs +Proxy @name)) [ObjectField Value] +vs parseObjectOrEnum VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (Term sch ('DRecord name args)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3691,17 +3691,17 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance (EnumParser choices, KnownName name) - => ObjectOrEnumParser sch ('DEnum name choices) where - parseObjectOrEnum :: VariableMap -> Text -> Value -> f (Term sch ('DEnum name choices)) -parseObjectOrEnum VariableMap +instance (EnumParser choices, KnownName name) + => ObjectOrEnumParser sch ('DEnum name choices) where + parseObjectOrEnum :: VariableMap -> Text -> Value -> f (Term sch ('DEnum name choices)) +parseObjectOrEnum VariableMap _ Text -_ (GQL.Enum Text -nm) +_ (GQL.Enum Text +nm) = NS Proxy choices -> Term sch ('DEnum name choices) forall fieldName typeName (choices :: [ChoiceDef fieldName]) (sch :: Schema typeName fieldName) (name :: typeName). @@ -3722,11 +3722,11 @@ KnownName a => proxy a -> [Char] nameVal (Proxy name forall k (t :: k). Proxy t -Proxy @name)) Text -nm +Proxy @name)) Text +nm parseObjectOrEnum VariableMap -_ Text -aname Value +_ Text +aname Value _ = Text -> f (Term sch ('DEnum name choices)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3737,22 +3737,22 @@ forall a b. (a -> b) -> a -> b "argument '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -aname Text -> Text -> Text +aname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -class ObjectParser (sch :: Schema') (args :: [FieldDef Symbol Symbol]) where - objectParser :: MonadError T.Text f +class ObjectParser (sch :: Schema') (args :: [FieldDef Symbol Symbol]) where + objectParser :: MonadError T.Text f => VariableMap -> T.Text -> [GQL.ObjectField GQL.Value] - -> f (NP (Field sch) args) + -> f (NP (Field sch) args) -instance ObjectParser sch '[] where - objectParser :: VariableMap +instance ObjectParser sch '[] where + objectParser :: VariableMap -> Text -> [ObjectField Value] -> f (NP (Field sch) '[]) -objectParser VariableMap +objectParser VariableMap _ Text _ [ObjectField Value] _ = NP (Field sch) '[] -> f (NP (Field sch) '[]) @@ -3760,20 +3760,20 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure NP (Field sch) '[] forall k (a :: k -> *). NP a '[] Nil -instance - (ObjectParser sch args, ValueParser sch v, KnownName nm) => - ObjectParser sch ('FieldDef nm v ': args) +instance + (ObjectParser sch args, ValueParser sch v, KnownName nm) => + ObjectParser sch ('FieldDef nm v ': args) where - objectParser :: VariableMap + objectParser :: VariableMap -> Text -> [ObjectField Value] -> f (NP (Field sch) ('FieldDef nm v : args)) -objectParser VariableMap -vmap Text -tyName [ObjectField Value] -args - = let wanted :: Text -wanted = [Char] -> Text +objectParser VariableMap +vmap Text +tyName [ObjectField Value] +args + = let wanted :: Text +wanted = [Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy nm -> [Char] @@ -3782,23 +3782,23 @@ KnownName a => proxy a -> [Char] nameVal (Proxy nm forall k (t :: k). Proxy t -Proxy @nm) +Proxy @nm) in case (ObjectField Value -> Bool) -> [ObjectField Value] -> Maybe (ObjectField Value) forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find ((Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -wanted) (Text -> Bool) +wanted) (Text -> Bool) -> (ObjectField Value -> Text) -> ObjectField Value -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ObjectField Value -> Text forall a. ObjectField a -> Text GQL.name) [ObjectField Value] -args of +args of Just (GQL.ObjectField Text -_ (GQL.Node Value -v Location +_ (GQL.Node Value +v Location _) Location _) -> Field sch ('FieldDef nm v) @@ -3823,9 +3823,9 @@ forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser' VariableMap -vmap Text -wanted Value -v) f (NP (Field sch) args -> NP (Field sch) ('FieldDef nm v : args)) +vmap Text +wanted Value +v) f (NP (Field sch) args -> NP (Field sch) ('FieldDef nm v : args)) -> f (NP (Field sch) args) -> f (NP (Field sch) ('FieldDef nm v : args)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b @@ -3837,9 +3837,9 @@ forall (sch :: Schema') (args :: [FieldDef Symbol Symbol]) VariableMap -> Text -> [ObjectField Value] -> f (NP (Field sch) args) objectParser VariableMap -vmap Text -tyName [ObjectField Value] -args +vmap Text +tyName [ObjectField Value] +args Maybe (ObjectField Value) Nothing -> Text -> f (NP (Field sch) ('FieldDef nm v : args)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3850,27 +3850,27 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -wanted Text -> Text -> Text +wanted Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found on type '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -tyName Text -> Text -> Text +tyName Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'" -class EnumParser (choices :: [ChoiceDef Symbol]) where - enumParser :: MonadError T.Text f +class EnumParser (choices :: [ChoiceDef Symbol]) where + enumParser :: MonadError T.Text f => T.Text -> GQL.Name - -> f (NS Proxy choices) + -> f (NS Proxy choices) instance EnumParser '[] where - enumParser :: Text -> Text -> f (NS Proxy '[]) -enumParser Text -tyName Text -wanted + enumParser :: Text -> Text -> f (NS Proxy '[]) +enumParser Text +tyName Text +wanted = Text -> f (NS Proxy '[]) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (NS Proxy '[])) -> Text -> f (NS Proxy '[]) @@ -3879,27 +3879,27 @@ forall a b. (a -> b) -> a -> b "value '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -wanted Text -> Text -> Text +wanted Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found on enum '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -tyName Text -> Text -> Text +tyName Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'" -instance (KnownName name, EnumParser choices) - => EnumParser ('ChoiceDef name ': choices) where - enumParser :: Text -> Text -> f (NS Proxy ('ChoiceDef name : choices)) -enumParser Text -tyName Text -wanted +instance (KnownName name, EnumParser choices) + => EnumParser ('ChoiceDef name ': choices) where + enumParser :: Text -> Text -> f (NS Proxy ('ChoiceDef name : choices)) +enumParser Text +tyName Text +wanted | Text -wanted Text -> Text -> Bool +wanted Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -mname = NS Proxy ('ChoiceDef name : choices) +mname = NS Proxy ('ChoiceDef name : choices) -> f (NS Proxy ('ChoiceDef name : choices)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Proxy ('ChoiceDef name) -> NS Proxy ('ChoiceDef name : choices) @@ -3919,11 +3919,11 @@ forall (choices :: [ChoiceDef Symbol]) (f :: * -> *). (EnumParser choices, MonadError Text f) => Text -> Text -> f (NS Proxy choices) enumParser Text -tyName Text -wanted +tyName Text +wanted where - mname :: Text -mname = [Char] -> Text + mname :: Text +mname = [Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy name -> [Char] @@ -3932,23 +3932,23 @@ KnownName a => proxy a -> [Char] nameVal (Proxy name forall k (t :: k). Proxy t -Proxy @name) +Proxy @name) -valueParser' :: (ValueParser sch v, MonadError T.Text f) +valueParser' :: (ValueParser sch v, MonadError T.Text f) => VariableMap -> T.Text -> GQL.Value - -> f (FieldValue sch v) + -> f (FieldValue sch v) valueParser' :: VariableMap -> Text -> Value -> f (FieldValue sch v) -valueParser' VariableMap -vmap Text -aname (GQL.Variable Text -x) +valueParser' VariableMap +vmap Text +aname (GQL.Variable Text +x) = case Text -> VariableMap -> Maybe Value forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -x VariableMap -vmap of +x VariableMap +vmap of Maybe Value Nothing -> Text -> f (FieldValue sch v) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -3958,41 +3958,41 @@ forall a b. (a -> b) -> a -> b "variable '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -x Text -> Text -> Text +x Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" - Just Value -v -> VariableMap -> Text -> Value -> f (FieldValue sch v) + Just Value +v -> VariableMap -> Text -> Value -> f (FieldValue sch v) forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser VariableMap -vmap Text -aname Value -v -valueParser' VariableMap -vmap Text -aname Value -v = VariableMap -> Text -> Value -> f (FieldValue sch v) +vmap Text +aname Value +v +valueParser' VariableMap +vmap Text +aname Value +v = VariableMap -> Text -> Value -> f (FieldValue sch v) forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser VariableMap -vmap Text -aname Value -v +vmap Text +aname Value +v -class ValueParser (sch :: Schema') (v :: FieldType Symbol) where - valueParser :: MonadError T.Text f +class ValueParser (sch :: Schema') (v :: FieldType Symbol) where + valueParser :: MonadError T.Text f => VariableMap -> T.Text -> GQL.Value - -> f (FieldValue sch v) + -> f (FieldValue sch v) -instance ValueParser sch 'TNull where - valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch 'TNull) -valueParser VariableMap +instance ValueParser sch 'TNull where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch 'TNull) +valueParser VariableMap _ Text _ Value GQL.Null = FieldValue sch 'TNull -> f (FieldValue sch 'TNull) @@ -4002,8 +4002,8 @@ forall typeName fieldName (sch :: Schema typeName fieldName). FieldValue sch 'TNull FNull valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch 'TNull) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch 'TNull)) @@ -4013,17 +4013,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive Bool) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive Bool) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Bool)) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.Boolean Bool -b) = FieldValue sch ('TPrimitive Bool) +_ (GQL.Boolean Bool +b) = FieldValue sch ('TPrimitive Bool) -> f (FieldValue sch ('TPrimitive Bool)) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive Bool) @@ -4035,10 +4035,10 @@ forall a b. (a -> b) -> a -> b forall typeName fieldName t1 (sch :: Schema typeName fieldName). t1 -> FieldValue sch ('TPrimitive t1) FPrimitive Bool -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Bool)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Bool))) @@ -4048,17 +4048,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive Int32) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive Int32) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Int32)) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.Int Int32 -b) = FieldValue sch ('TPrimitive Int32) +_ (GQL.Int Int32 +b) = FieldValue sch ('TPrimitive Int32) -> f (FieldValue sch ('TPrimitive Int32)) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive Int32) @@ -4075,10 +4075,10 @@ forall a b. (a -> b) -> a -> b $ Int32 -> Int32 forall a b. (Integral a, Num b) => a -> b fromIntegral Int32 -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Int32)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Int32))) @@ -4088,17 +4088,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive Integer) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive Integer) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Integer)) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.Int Int32 -b) = FieldValue sch ('TPrimitive Integer) +_ (GQL.Int Int32 +b) = FieldValue sch ('TPrimitive Integer) -> f (FieldValue sch ('TPrimitive Integer)) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive Integer) @@ -4115,10 +4115,10 @@ forall a b. (a -> b) -> a -> b $ Int32 -> Integer forall a. Integral a => a -> Integer toInteger Int32 -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Integer)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Integer))) @@ -4128,17 +4128,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive Scientific) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive Scientific) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Scientific)) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.Float Double -b) = FieldValue sch ('TPrimitive Scientific) +_ (GQL.Float Double +b) = FieldValue sch ('TPrimitive Scientific) -> f (FieldValue sch ('TPrimitive Scientific)) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive Scientific) @@ -4155,10 +4155,10 @@ forall a b. (a -> b) -> a -> b $ Double -> Scientific forall a. RealFloat a => a -> Scientific fromFloatDigits Double -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Scientific)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Scientific))) @@ -4168,17 +4168,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive Double) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive Double) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Double)) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.Float Double -b) = FieldValue sch ('TPrimitive Double) +_ (GQL.Float Double +b) = FieldValue sch ('TPrimitive Double) -> f (FieldValue sch ('TPrimitive Double)) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive Double) @@ -4190,10 +4190,10 @@ forall a b. (a -> b) -> a -> b forall typeName fieldName t1 (sch :: Schema typeName fieldName). t1 -> FieldValue sch ('TPrimitive t1) FPrimitive Double -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Double)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Double))) @@ -4203,17 +4203,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive T.Text) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive T.Text) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Text)) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.String Text -b) = FieldValue sch ('TPrimitive Text) +_ (GQL.String Text +b) = FieldValue sch ('TPrimitive Text) -> f (FieldValue sch ('TPrimitive Text)) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive Text) @@ -4225,10 +4225,10 @@ forall a b. (a -> b) -> a -> b forall typeName fieldName t1 (sch :: Schema typeName fieldName). t1 -> FieldValue sch ('TPrimitive t1) FPrimitive Text -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Text)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Text))) @@ -4238,17 +4238,17 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance ValueParser sch ('TPrimitive String) where - valueParser :: VariableMap +instance ValueParser sch ('TPrimitive String) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive [Char])) -valueParser VariableMap +valueParser VariableMap _ Text -_ (GQL.String Text -b) = FieldValue sch ('TPrimitive [Char]) +_ (GQL.String Text +b) = FieldValue sch ('TPrimitive [Char]) -> f (FieldValue sch ('TPrimitive [Char])) forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldValue sch ('TPrimitive [Char]) @@ -4264,10 +4264,10 @@ t1 -> FieldValue sch ('TPrimitive t1) forall a b. (a -> b) -> a -> b $ Text -> [Char] T.unpack Text -b +b valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive [Char])) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive [Char]))) @@ -4277,16 +4277,16 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance (ValueParser sch r) => ValueParser sch ('TList r) where - valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TList r)) -valueParser VariableMap -vmap Text -fname (GQL.List [Node Value] -xs) = [FieldValue sch r] -> FieldValue sch ('TList r) +instance (ValueParser sch r) => ValueParser sch ('TList r) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TList r)) +valueParser VariableMap +vmap Text +fname (GQL.List [Node Value] +xs) = [FieldValue sch r] -> FieldValue sch ('TList r) forall typeName fieldName (sch :: Schema typeName fieldName) (t1 :: FieldType typeName). [FieldValue sch t1] -> FieldValue sch ('TList t1) @@ -4303,17 +4303,17 @@ forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser' VariableMap -vmap Text -fname (Value -> f (FieldValue sch r)) +vmap Text +fname (Value -> f (FieldValue sch r)) -> (Node Value -> Value) -> Node Value -> f (FieldValue sch r) forall b c a. (b -> c) -> (a -> b) -> a -> c . Node Value -> Value forall a. Node a -> a GQL.node) [Node Value] -xs +xs valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TList r)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TList r))) @@ -4323,13 +4323,13 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -instance (ValueParser sch r) => ValueParser sch ('TOption r) where - valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TOption r)) -valueParser VariableMap +instance (ValueParser sch r) => ValueParser sch ('TOption r) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TOption r)) +valueParser VariableMap _ Text _ Value GQL.Null = FieldValue sch ('TOption r) -> f (FieldValue sch ('TOption r)) @@ -4344,10 +4344,10 @@ Maybe (FieldValue sch t1) -> FieldValue sch ('TOption t1) FOption Maybe (FieldValue sch r) forall a. Maybe a Nothing - valueParser VariableMap -vmap Text -fname Value -v = Maybe (FieldValue sch r) -> FieldValue sch ('TOption r) + valueParser VariableMap +vmap Text +fname Value +v = Maybe (FieldValue sch r) -> FieldValue sch ('TOption r) forall typeName fieldName (sch :: Schema typeName fieldName) (t1 :: FieldType typeName). Maybe (FieldValue sch t1) -> FieldValue sch ('TOption t1) @@ -4366,17 +4366,17 @@ forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *). (ValueParser sch v, MonadError Text f) => VariableMap -> Text -> Value -> f (FieldValue sch v) valueParser' VariableMap -vmap Text -fname Value -v -instance (ObjectOrEnumParser sch (sch :/: sty), KnownName sty) - => ValueParser sch ('TSchematic sty) where - valueParser :: VariableMap +vmap Text +fname Value +v +instance (ObjectOrEnumParser sch (sch :/: sty), KnownName sty) + => ValueParser sch ('TSchematic sty) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TSchematic sty)) -valueParser VariableMap -vmap Text -_ Value -v = Term sch (sch :/: sty) -> FieldValue sch ('TSchematic sty) +valueParser VariableMap +vmap Text +_ Value +v = Term sch (sch :/: sty) -> FieldValue sch ('TSchematic sty) forall typeName fieldName (sch :: Schema typeName fieldName) (t1 :: typeName). Term sch (sch :/: t1) -> FieldValue sch ('TSchematic t1) @@ -4390,7 +4390,7 @@ forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol) (ObjectOrEnumParser sch t, MonadError Text f) => VariableMap -> Text -> Value -> f (Term sch t) parseObjectOrEnum' VariableMap -vmap ([Char] -> Text +vmap ([Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy sty -> [Char] @@ -4399,15 +4399,15 @@ KnownName a => proxy a -> [Char] nameVal (Proxy sty forall k (t :: k). Proxy t -Proxy @sty)) Value -v -instance ValueParser sch ('TPrimitive A.Value) where - valueParser :: VariableMap +Proxy @sty)) Value +v +instance ValueParser sch ('TPrimitive A.Value) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Value)) -valueParser VariableMap -vmap Text -_ Value -x = Value -> FieldValue sch ('TPrimitive Value) +valueParser VariableMap +vmap Text +_ Value +x = Value -> FieldValue sch ('TPrimitive Value) forall typeName fieldName t1 (sch :: Schema typeName fieldName). t1 -> FieldValue sch ('TPrimitive t1) FPrimitive (Value -> FieldValue sch ('TPrimitive Value)) @@ -4418,15 +4418,15 @@ forall (m :: * -> *). MonadError Text m => VariableMap -> Value -> m Value toAesonValue VariableMap -vmap Value -x -instance ValueParser sch ('TPrimitive A.Object) where - valueParser :: VariableMap +vmap Value +x +instance ValueParser sch ('TPrimitive A.Object) where + valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TPrimitive Object)) -valueParser VariableMap -vm Text -_ (GQL.Object [ObjectField Value] -xs) = Object -> FieldValue sch ('TPrimitive Object) +valueParser VariableMap +vm Text +_ (GQL.Object [ObjectField Value] +xs) = Object -> FieldValue sch ('TPrimitive Object) forall typeName fieldName t1 (sch :: Schema typeName fieldName). t1 -> FieldValue sch ('TPrimitive t1) FPrimitive (Object -> FieldValue sch ('TPrimitive Object)) @@ -4449,11 +4449,11 @@ forall (m :: * -> *). MonadError Text m => VariableMap -> ObjectField Value -> m (Text, Value) toKeyValuePairs VariableMap -vm) [ObjectField Value] -xs +vm) [ObjectField Value] +xs valueParser VariableMap -_ Text -fname Value +_ Text +fname Value _ = Text -> f (FieldValue sch ('TPrimitive Object)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (Text -> f (FieldValue sch ('TPrimitive Object))) @@ -4463,39 +4463,39 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not of right type" -toKeyValuePairs :: MonadError T.Text m => VariableMap -> GQL.ObjectField GQL.Value -> m (T.Text, A.Value) +toKeyValuePairs :: MonadError T.Text m => VariableMap -> GQL.ObjectField GQL.Value -> m (T.Text, A.Value) toKeyValuePairs :: VariableMap -> ObjectField Value -> m (Text, Value) -toKeyValuePairs VariableMap -vmap (GQL.ObjectField Text -key (GQL.Node Value -v Location +toKeyValuePairs VariableMap +vmap (GQL.ObjectField Text +key (GQL.Node Value +v Location _) Location _) = (Text -key,) (Value -> (Text, Value)) -> m Value -> m (Text, Value) +key,) (Value -> (Text, Value)) -> m Value -> m (Text, Value) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> VariableMap -> Value -> m Value forall (m :: * -> *). MonadError Text m => VariableMap -> Value -> m Value toAesonValue VariableMap -vmap Value -v +vmap Value +v -toAesonValue :: MonadError T.Text m => VariableMap -> GQL.Value -> m A.Value +toAesonValue :: MonadError T.Text m => VariableMap -> GQL.Value -> m A.Value toAesonValue :: VariableMap -> Value -> m Value -toAesonValue VariableMap -vm (GQL.Variable Text -v) = +toAesonValue VariableMap +vm (GQL.Variable Text +v) = case Text -> VariableMap -> Maybe Value forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -v VariableMap -vm of +v VariableMap +vm of Maybe Value Nothing -> Text -> m Value forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -4505,21 +4505,21 @@ forall a b. (a -> b) -> a -> b "variable '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -v Text -> Text -> Text +v Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" - Just Value -xs -> VariableMap -> Value -> m Value + Just Value +xs -> VariableMap -> Value -> m Value forall (m :: * -> *). MonadError Text m => VariableMap -> Value -> m Value toAesonValue VariableMap -vm Value -xs +vm Value +xs toAesonValue VariableMap -_ (GQL.Int Int32 -n) = Value -> m Value +_ (GQL.Int Int32 +n) = Value -> m Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> m Value) -> (Scientific -> Value) -> Scientific -> m Value @@ -4530,10 +4530,10 @@ forall a b. (a -> b) -> a -> b $ Int32 -> Scientific forall a b. (Integral a, Num b) => a -> b fromIntegral Int32 -n +n toAesonValue VariableMap -_ (GQL.Float Double -d) = Value -> m Value +_ (GQL.Float Double +d) = Value -> m Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> m Value) -> (Scientific -> Value) -> Scientific -> m Value @@ -4544,25 +4544,25 @@ forall a b. (a -> b) -> a -> b $ Double -> Scientific forall a. RealFloat a => a -> Scientific fromFloatDigits Double -d +d toAesonValue VariableMap -_ (GQL.String Text -s) = Value -> m Value +_ (GQL.String Text +s) = Value -> m Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> m Value) -> Value -> m Value forall a b. (a -> b) -> a -> b $ Text -> Value A.String Text -s +s toAesonValue VariableMap -_ (GQL.Boolean Bool -b) = Value -> m Value +_ (GQL.Boolean Bool +b) = Value -> m Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> m Value) -> Value -> m Value forall a b. (a -> b) -> a -> b $ Bool -> Value A.Bool Bool -b +b toAesonValue VariableMap _ Value GQL.Null = Value -> m Value @@ -4570,17 +4570,17 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure Value A.Null toAesonValue VariableMap -_ (GQL.Enum Text -e) = Value -> m Value +_ (GQL.Enum Text +e) = Value -> m Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> m Value) -> Value -> m Value forall a b. (a -> b) -> a -> b $ Text -> Value A.String Text -e -toAesonValue VariableMap -vm (GQL.List [Node Value] -xs) = [Value] -> Value +e +toAesonValue VariableMap +vm (GQL.List [Node Value] +xs) = [Value] -> Value forall a. ToJSON a => a -> Value A.toJSON ([Value] -> Value) -> m [Value] -> m Value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -4593,16 +4593,16 @@ forall (m :: * -> *). MonadError Text m => VariableMap -> Value -> m Value toAesonValue VariableMap -vm (Value -> m Value) +vm (Value -> m Value) -> (Node Value -> Value) -> Node Value -> m Value forall b c a. (b -> c) -> (a -> b) -> a -> c . Node Value -> Value forall a. Node a -> a GQL.node) [Node Value] -xs -toAesonValue VariableMap -vm (GQL.Object [ObjectField Value] -xs) = Object -> Value +xs +toAesonValue VariableMap +vm (GQL.Object [ObjectField Value] +xs) = Object -> Value A.Object (Object -> Value) -> ([(Text, Value)] -> Object) -> [(Text, Value)] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c @@ -4620,23 +4620,23 @@ forall (m :: * -> *). MonadError Text m => VariableMap -> ObjectField Value -> m (Text, Value) toKeyValuePairs VariableMap -vm) [ObjectField Value] -xs +vm) [ObjectField Value] +xs -class ParseDifferentReturn (p :: Package') (r :: Return Symbol (TypeRef Symbol)) where - parseDiffReturn :: MonadError T.Text f +class ParseDifferentReturn (p :: Package') (r :: Return Symbol (TypeRef Symbol)) where + parseDiffReturn :: MonadError T.Text f => VariableMap -> FragmentMap -> T.Text -> [GQL.Selection] - -> f (ReturnQuery p r) -instance ParseDifferentReturn p 'RetNothing where - parseDiffReturn :: VariableMap + -> f (ReturnQuery p r) +instance ParseDifferentReturn p 'RetNothing where + parseDiffReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery p 'RetNothing) -parseDiffReturn VariableMap +parseDiffReturn VariableMap _ FragmentMap _ Text _ [] = ReturnQuery p 'RetNothing -> f (ReturnQuery p 'RetNothing) @@ -4647,8 +4647,8 @@ ReturnQuery p 'RetNothing RNothing parseDiffReturn VariableMap _ FragmentMap -_ Text -fname [Selection] +_ Text +fname [Selection] _ = Text -> f (ReturnQuery p 'RetNothing) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -4659,21 +4659,21 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' should not have a selection of subfields" -instance ParseReturn p r => ParseDifferentReturn p ('RetSingle r) where - parseDiffReturn :: VariableMap +instance ParseReturn p r => ParseDifferentReturn p ('RetSingle r) where + parseDiffReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery p ('RetSingle r)) -parseDiffReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseDiffReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = ReturnQuery' p r -> ReturnQuery p ('RetSingle r) forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (r :: TypeRef snm). @@ -4688,21 +4688,21 @@ forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *). VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r) parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s -instance ParseReturn p r => ParseDifferentReturn p ('RetStream r) where - parseDiffReturn :: VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s +instance ParseReturn p r => ParseDifferentReturn p ('RetStream r) where + parseDiffReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery p ('RetStream r)) -parseDiffReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseDiffReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = ReturnQuery' p r -> ReturnQuery p ('RetStream r) forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) (r :: TypeRef snm). @@ -4717,26 +4717,26 @@ forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *). VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r) parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +vmap FragmentMap +frmap Text +fname [Selection] +s -class ParseReturn (p :: Package') (r :: TypeRef Symbol) where - parseReturn :: MonadError T.Text f +class ParseReturn (p :: Package') (r :: TypeRef Symbol) where + parseReturn :: MonadError T.Text f => VariableMap -> FragmentMap -> T.Text -> [GQL.Selection] - -> f (ReturnQuery' p r) + -> f (ReturnQuery' p r) -instance ParseReturn p ('PrimitiveRef t) where - parseReturn :: VariableMap +instance ParseReturn p ('PrimitiveRef t) where + parseReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p ('PrimitiveRef t)) -parseReturn VariableMap +parseReturn VariableMap _ FragmentMap _ Text _ [] @@ -4749,8 +4749,8 @@ ReturnQuery' p ('PrimitiveRef t) RetPrimitive parseReturn VariableMap _ FragmentMap -_ Text -fname [Selection] +_ Text +fname [Selection] _ = Text -> f (ReturnQuery' p ('PrimitiveRef t)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -4761,22 +4761,22 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' should not have a selection of subfields" -instance (ParseSchema sch (sch :/: sty)) - => ParseReturn p ('SchemaRef sch sty) where - parseReturn :: VariableMap +instance (ParseSchema sch (sch :/: sty)) + => ParseReturn p ('SchemaRef sch sty) where + parseReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p ('SchemaRef sch sty)) -parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = SchemaQuery sch (sch :/: sty) -> ReturnQuery' p ('SchemaRef sch sty) forall typeName fieldName snm mnm anm @@ -4799,22 +4799,22 @@ forall (s :: Schema') (t :: TypeDefB * Symbol Symbol) VariableMap -> FragmentMap -> Text -> [Selection] -> f (SchemaQuery s t) parseSchema VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s -instance ParseReturn p r - => ParseReturn p ('ListRef r) where - parseReturn :: VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s +instance ParseReturn p r + => ParseReturn p ('ListRef r) where + parseReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p ('ListRef r)) -parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = ReturnQuery' p r -> ReturnQuery' p ('ListRef r) forall serviceName mnm anm (p :: Package serviceName mnm anm (TypeRef serviceName)) @@ -4830,22 +4830,22 @@ forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *). VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r) parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s -instance ParseReturn p r - => ParseReturn p ('OptionalRef r) where - parseReturn :: VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s +instance ParseReturn p r + => ParseReturn p ('OptionalRef r) where + parseReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p ('OptionalRef r)) -parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = ReturnQuery' p r -> ReturnQuery' p ('OptionalRef r) forall serviceName mnm anm (p :: Package serviceName mnm anm (TypeRef serviceName)) @@ -4861,22 +4861,22 @@ forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *). VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r) parseReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s -instance ( p ~ 'Package pname ss, ParseQuery p s, KnownName s ) - => ParseReturn p ('ObjectRef s) where - parseReturn :: VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s +instance ( p ~ 'Package pname ss, ParseQuery p s, KnownName s ) + => ParseReturn p ('ObjectRef s) where + parseReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p ('ObjectRef s)) -parseReturn VariableMap -vmap FragmentMap -frmap Text -_ [Selection] -s +parseReturn VariableMap +vmap FragmentMap +frmap Text +_ [Selection] +s = ServiceQuery ('Package pname ss) (LookupService ss s) -> ReturnQuery' ('Package pname ss) ('ObjectRef s) forall serviceName mnm anm (pname :: Maybe serviceName) @@ -4908,27 +4908,27 @@ Proxy p -> f (ServiceQuery p (LookupService ss s)) parseQuery (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy s +Proxy @p) (Proxy s forall k (t :: k). Proxy t -Proxy @s) VariableMap -vmap FragmentMap -frmap [Selection] -s +Proxy @s) VariableMap +vmap FragmentMap +frmap [Selection] +s -class ParseSchema (s :: Schema') (t :: TypeDef Symbol Symbol) where - parseSchema :: MonadError T.Text f +class ParseSchema (s :: Schema') (t :: TypeDef Symbol Symbol) where + parseSchema :: MonadError T.Text f => VariableMap -> FragmentMap -> T.Text -> [GQL.Selection] - -> f (SchemaQuery s t) -instance ParseSchema sch ('DEnum name choices) where - parseSchema :: VariableMap + -> f (SchemaQuery s t) +instance ParseSchema sch ('DEnum name choices) where + parseSchema :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (SchemaQuery sch ('DEnum name choices)) -parseSchema VariableMap +parseSchema VariableMap _ FragmentMap _ Text _ [] @@ -4942,8 +4942,8 @@ SchemaQuery sch ('DEnum nm choices) QueryEnum parseSchema VariableMap _ FragmentMap -_ Text -fname [Selection] +_ Text +fname [Selection] _ = Text -> f (SchemaQuery sch ('DEnum name choices)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -4954,22 +4954,22 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' should not have a selection of subfields" -instance (KnownName name, ParseField sch fields) - => ParseSchema sch ('DRecord name fields) where - parseSchema :: VariableMap +instance (KnownName name, ParseField sch fields) + => ParseSchema sch ('DRecord name fields) where + parseSchema :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (SchemaQuery sch ('DRecord name fields)) -parseSchema VariableMap -vmap FragmentMap -frmap Text -_ [Selection] -s +parseSchema VariableMap +vmap FragmentMap +frmap Text +_ [Selection] +s = [OneFieldQuery sch fields] -> SchemaQuery sch ('DRecord name fields) forall typeName fieldName (sch :: Schema typeName fieldName) @@ -4999,23 +4999,23 @@ Proxy sch -> f [OneFieldQuery sch fields] parseSchemaQuery (Proxy sch forall k (t :: k). Proxy t -Proxy @sch) (Proxy ('DRecord name fields) +Proxy @sch) (Proxy ('DRecord name fields) forall k (t :: k). Proxy t -Proxy @('DRecord name fields)) VariableMap -vmap FragmentMap -frmap [Selection] -s +Proxy @('DRecord name fields)) VariableMap +vmap FragmentMap +frmap [Selection] +s parseSchemaQuery :: - forall (sch :: Schema') t (rname :: Symbol) fields f. - ( MonadError T.Text f - , t ~  'DRecord rname fields - , KnownName rname - , ParseField sch fields ) => - Proxy sch -> - Proxy t -> + forall (sch :: Schema') t (rname :: Symbol) fields f. + ( MonadError T.Text f + , t ~  'DRecord rname fields + , KnownName rname + , ParseField sch fields ) => + Proxy sch -> + Proxy t -> VariableMap -> FragmentMap -> [GQL.Selection] -> - f [OneFieldQuery sch fields] + f [OneFieldQuery sch fields] parseSchemaQuery :: Proxy sch -> Proxy t -> VariableMap @@ -5029,13 +5029,13 @@ forall k (t :: k). Proxy t _ [] = [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields] forall (f :: * -> *) a. Applicative f => a -> f a pure [] -parseSchemaQuery Proxy sch -pp Proxy t -ps VariableMap -vmap FragmentMap -frmap (GQL.FieldSelection Field -fld : [Selection] -ss) +parseSchemaQuery Proxy sch +pp Proxy t +ps VariableMap +vmap FragmentMap +frmap (GQL.FieldSelection Field +fld : [Selection] +ss) = [OneFieldQuery sch fields] -> [OneFieldQuery sch fields] -> [OneFieldQuery sch fields] forall a. [a] -> [a] -> [a] @@ -5051,8 +5051,8 @@ forall a. Maybe a -> [a] -> f [OneFieldQuery sch fields] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Field -> f (Maybe (OneFieldQuery sch fields)) -fieldToMethod Field -fld) +fieldToMethod Field +fld) f ([OneFieldQuery sch fields] -> [OneFieldQuery sch fields]) -> f [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b @@ -5074,27 +5074,27 @@ Proxy sch -> [Selection] -> f [OneFieldQuery sch fields] parseSchemaQuery Proxy sch -pp Proxy t -ps VariableMap -vmap FragmentMap -frmap [Selection] -ss +pp Proxy t +ps VariableMap +vmap FragmentMap +frmap [Selection] +ss where - fieldToMethod :: GQL.Field -> f (Maybe (OneFieldQuery sch fields)) - fieldToMethod :: Field -> f (Maybe (OneFieldQuery sch fields)) -fieldToMethod (GQL.Field Maybe Text -alias Text -name [Argument] -args [Directive] -dirs [Selection] -sels Location + fieldToMethod :: GQL.Field -> f (Maybe (OneFieldQuery sch fields)) + fieldToMethod :: Field -> f (Maybe (OneFieldQuery sch fields)) +fieldToMethod (GQL.Field Maybe Text +alias Text +name [Argument] +args [Directive] +dirs [Selection] +sels Location _) | (Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs +vmap) [Directive] +dirs = Maybe (OneFieldQuery sch fields) -> f (Maybe (OneFieldQuery sch fields)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -5102,13 +5102,13 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a. Maybe a Nothing | Text -name Text -> Text -> Bool +name Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text "__typename" = case ([Argument] -args, [Selection] -sels) of +args, [Selection] +sels) of ([], []) -> Maybe (OneFieldQuery sch fields) -> f (Maybe (OneFieldQuery sch fields)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -5126,7 +5126,7 @@ forall a b. (a -> b) -> a -> b forall tn fn (sch :: Schema tn fn) (fs :: [FieldDef tn fn]). Maybe Text -> OneFieldQuery sch fs TypeNameFieldQuery Maybe Text -alias +alias ([Argument], [Selection]) _ -> Text -> f (Maybe (OneFieldQuery sch fields)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -5135,7 +5135,7 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a | Argument _:[Argument] _ <- [Argument] -args +args = Text -> f (Maybe (OneFieldQuery sch fields)) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text @@ -5154,7 +5154,7 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c forall tn fn (sch :: Schema tn fn) (fs :: [FieldDef tn fn]). Maybe Text -> NS (ChosenFieldQuery sch) fs -> OneFieldQuery sch fs OneFieldQuery Maybe Text -alias +alias (NS (ChosenFieldQuery sch) fields -> Maybe (OneFieldQuery sch fields)) -> f (NS (ChosenFieldQuery sch) fields) @@ -5184,43 +5184,43 @@ KnownName a => proxy a -> [Char] nameVal (Proxy rname forall k (t :: k). Proxy t -Proxy @rname)) VariableMap -vmap FragmentMap -frmap Text -name [Selection] -sels -parseSchemaQuery Proxy sch -pp Proxy t -ps VariableMap -vmap FragmentMap -frmap (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text -nm [Directive] -dirs Location -_) : [Selection] -ss) - | Just FragmentDefinition -fr <- Text -> FragmentMap -> Maybe FragmentDefinition +Proxy @rname)) VariableMap +vmap FragmentMap +frmap Text +name [Selection] +sels +parseSchemaQuery Proxy sch +pp Proxy t +ps VariableMap +vmap FragmentMap +frmap (GQL.FragmentSpreadSelection (GQL.FragmentSpread Text +nm [Directive] +dirs Location +_) : [Selection] +ss) + | Just FragmentDefinition +fr <- Text -> FragmentMap -> Maybe FragmentDefinition forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -nm FragmentMap -frmap +nm FragmentMap +frmap = if Bool -> Bool not ((Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) [Directive] -dirs) Bool -> Bool -> Bool +vmap) [Directive] +dirs) Bool -> Bool -> Bool && Bool -> Bool not ((Directive -> Bool) -> [Directive] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (VariableMap -> Directive -> Bool shouldSkip VariableMap -vmap) ([Directive] -> Bool) -> [Directive] -> Bool +vmap) ([Directive] -> Bool) -> [Directive] -> Bool forall a b. (a -> b) -> a -> b $ FragmentDefinition -> [Directive] fdDirectives FragmentDefinition -fr) +fr) then [OneFieldQuery sch fields] -> [OneFieldQuery sch fields] -> [OneFieldQuery sch fields] forall a. [a] -> [a] -> [a] @@ -5247,12 +5247,12 @@ Proxy sch -> [Selection] -> f [OneFieldQuery sch fields] parseSchemaQuery Proxy sch -pp Proxy t -ps VariableMap -vmap FragmentMap -frmap (FragmentDefinition -> [Selection] +pp Proxy t +ps VariableMap +vmap FragmentMap +frmap (FragmentDefinition -> [Selection] fdSelectionSet FragmentDefinition -fr) +fr) f ([OneFieldQuery sch fields] -> [OneFieldQuery sch fields]) -> f [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b @@ -5274,11 +5274,11 @@ Proxy sch -> [Selection] -> f [OneFieldQuery sch fields] parseSchemaQuery Proxy sch -pp Proxy t -ps VariableMap -vmap FragmentMap -frmap [Selection] -ss +pp Proxy t +ps VariableMap +vmap FragmentMap +frmap [Selection] +ss else Proxy sch -> Proxy t -> VariableMap @@ -5297,11 +5297,11 @@ Proxy sch -> [Selection] -> f [OneFieldQuery sch fields] parseSchemaQuery Proxy sch -pp Proxy t -ps VariableMap -vmap FragmentMap -frmap [Selection] -ss +pp Proxy t +ps VariableMap +vmap FragmentMap +frmap [Selection] +ss | Bool otherwise -- the fragment definition was not found = Text -> f [OneFieldQuery sch fields] @@ -5313,7 +5313,7 @@ forall a b. (a -> b) -> a -> b "fragment '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -nm Text -> Text -> Text +nm Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found" @@ -5329,28 +5329,28 @@ forall e (m :: * -> *) a. MonadError e m => e -> m a throwError Text "inline fragments are not (yet) supported" -class ParseField (sch :: Schema') (fs :: [FieldDef Symbol Symbol]) where - selectField :: - MonadError T.Text f => +class ParseField (sch :: Schema') (fs :: [FieldDef Symbol Symbol]) where + selectField :: + MonadError T.Text f => T.Text -> VariableMap -> FragmentMap -> GQL.Name -> [GQL.Selection] -> - f (NS (ChosenFieldQuery sch) fs) + f (NS (ChosenFieldQuery sch) fs) -instance ParseField sch '[] where - selectField :: Text +instance ParseField sch '[] where + selectField :: Text -> VariableMap -> FragmentMap -> Text -> [Selection] -> f (NS (ChosenFieldQuery sch) '[]) -selectField Text -tyName VariableMap +selectField Text +tyName VariableMap _ FragmentMap -_ Text -wanted [Selection] +_ Text +wanted [Selection] _ = Text -> f (NS (ChosenFieldQuery sch) '[]) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -5361,37 +5361,37 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -wanted Text -> Text -> Text +wanted Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' was not found on type '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -tyName Text -> Text -> Text +tyName Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'" -instance - (KnownName fname, ParseField sch fs, ParseSchemaReturn sch r) => - ParseField sch ('FieldDef fname r ': fs) +instance + (KnownName fname, ParseField sch fs, ParseSchemaReturn sch r) => + ParseField sch ('FieldDef fname r ': fs) where - selectField :: Text + selectField :: Text -> VariableMap -> FragmentMap -> Text -> [Selection] -> f (NS (ChosenFieldQuery sch) ('FieldDef fname r : fs)) -selectField Text -tyName VariableMap -vmap FragmentMap -frmap Text -wanted [Selection] -sels +selectField Text +tyName VariableMap +vmap FragmentMap +frmap Text +wanted [Selection] +sels | Text -wanted Text -> Text -> Bool +wanted Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text -mname +mname = ChosenFieldQuery sch ('FieldDef fname r) -> NS (ChosenFieldQuery sch) ('FieldDef fname r : fs) forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs) @@ -5422,10 +5422,10 @@ VariableMap -> [Selection] -> f (ReturnSchemaQuery sch r) parseSchemaReturn VariableMap -vmap FragmentMap -frmap Text -wanted [Selection] -sels) +vmap FragmentMap +frmap Text +wanted [Selection] +sels) | Bool otherwise = NS (ChosenFieldQuery sch) fs @@ -5453,14 +5453,14 @@ Text -> [Selection] -> f (NS (ChosenFieldQuery sch) fs) selectField Text -tyName VariableMap -vmap FragmentMap -frmap Text -wanted [Selection] -sels +tyName VariableMap +vmap FragmentMap +frmap Text +wanted [Selection] +sels where - mname :: Text -mname = [Char] -> Text + mname :: Text +mname = [Char] -> Text T.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Proxy fname -> [Char] @@ -5469,23 +5469,23 @@ KnownName a => proxy a -> [Char] nameVal (Proxy fname forall k (t :: k). Proxy t -Proxy @fname) +Proxy @fname) -class ParseSchemaReturn (sch :: Schema') (r :: FieldType Symbol) where - parseSchemaReturn :: MonadError T.Text f +class ParseSchemaReturn (sch :: Schema') (r :: FieldType Symbol) where + parseSchemaReturn :: MonadError T.Text f => VariableMap -> FragmentMap -> T.Text -> [GQL.Selection] - -> f (ReturnSchemaQuery sch r) + -> f (ReturnSchemaQuery sch r) -instance ParseSchemaReturn sch ('TPrimitive t) where - parseSchemaReturn :: VariableMap +instance ParseSchemaReturn sch ('TPrimitive t) where + parseSchemaReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnSchemaQuery sch ('TPrimitive t)) -parseSchemaReturn VariableMap +parseSchemaReturn VariableMap _ FragmentMap _ Text _ [] @@ -5498,8 +5498,8 @@ ReturnSchemaQuery sch ('TPrimitive t) RetSchPrimitive parseSchemaReturn VariableMap _ FragmentMap -_ Text -fname [Selection] +_ Text +fname [Selection] _ = Text -> f (ReturnSchemaQuery sch ('TPrimitive t)) forall e (m :: * -> *) a. MonadError e m => e -> m a @@ -5510,22 +5510,22 @@ forall a b. (a -> b) -> a -> b "field '" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -fname Text -> Text -> Text +fname Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' should not have a selection of subfields" -instance ( ParseSchema sch (sch :/: sty) ) - => ParseSchemaReturn sch ('TSchematic sty) where - parseSchemaReturn :: VariableMap +instance ( ParseSchema sch (sch :/: sty) ) + => ParseSchemaReturn sch ('TSchematic sty) where + parseSchemaReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnSchemaQuery sch ('TSchematic sty)) -parseSchemaReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseSchemaReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = SchemaQuery sch (sch :/: sty) -> ReturnSchemaQuery sch ('TSchematic sty) forall typeName fn (sch :: Schema typeName fn) (sty :: typeName). @@ -5547,22 +5547,22 @@ forall (s :: Schema') (t :: TypeDefB * Symbol Symbol) VariableMap -> FragmentMap -> Text -> [Selection] -> f (SchemaQuery s t) parseSchema VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s -instance ParseSchemaReturn sch r - => ParseSchemaReturn sch ('TList r) where - parseSchemaReturn :: VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s +instance ParseSchemaReturn sch r + => ParseSchemaReturn sch ('TList r) where + parseSchemaReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnSchemaQuery sch ('TList r)) -parseSchemaReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseSchemaReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TList r) forall typeName fn (sch :: Schema typeName fn) (r :: FieldType typeName). @@ -5584,22 +5584,22 @@ VariableMap -> [Selection] -> f (ReturnSchemaQuery sch r) parseSchemaReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s -instance ParseSchemaReturn sch r - => ParseSchemaReturn sch ('TOption r) where - parseSchemaReturn :: VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s +instance ParseSchemaReturn sch r + => ParseSchemaReturn sch ('TOption r) where + parseSchemaReturn :: VariableMap -> FragmentMap -> Text -> [Selection] -> f (ReturnSchemaQuery sch ('TOption r)) -parseSchemaReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +parseSchemaReturn VariableMap +vmap FragmentMap +frmap Text +fname [Selection] +s = ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TOption r) forall typeName fn (sch :: Schema typeName fn) (r :: FieldType typeName). @@ -5621,62 +5621,62 @@ VariableMap -> [Selection] -> f (ReturnSchemaQuery sch r) parseSchemaReturn VariableMap -vmap FragmentMap -frmap Text -fname [Selection] -s +vmap FragmentMap +frmap Text +fname [Selection] +s -- some useful field accessors fdName :: GQL.FragmentDefinition -> GQL.Name fdName :: FragmentDefinition -> Text -fdName (GQL.FragmentDefinition Text -nm Text +fdName (GQL.FragmentDefinition Text +nm Text _ [Directive] _ SelectionSet _ Location _) = Text -nm +nm fdDirectives :: GQL.FragmentDefinition -> [GQL.Directive] fdDirectives :: FragmentDefinition -> [Directive] fdDirectives (GQL.FragmentDefinition Text _ Text -_ [Directive] -ds SelectionSet +_ [Directive] +ds SelectionSet _ Location _) = [Directive] -ds +ds fdSelectionSet :: GQL.FragmentDefinition -> [GQL.Selection] fdSelectionSet :: FragmentDefinition -> [Selection] fdSelectionSet (GQL.FragmentDefinition Text _ Text _ [Directive] -_ SelectionSet -ss Location +_ SelectionSet +ss Location _) = SelectionSet -> [Selection] forall (t :: * -> *) a. Foldable t => t a -> [a] F.toList SelectionSet -ss +ss argName :: GQL.Argument -> GQL.Name argName :: Argument -> Text -argName (GQL.Argument Text -nm Node Value +argName (GQL.Argument Text +nm Node Value _ Location _) = Text -nm +nm fName :: GQL.Field -> GQL.Name fName :: Field -> Text fName (GQL.Field Maybe Text -_ Text -nm [Argument] +_ Text +nm [Argument] _ [Directive] _ [Selection] _ Location _) = Text -nm +nm \ No newline at end of file diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Run.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Run.html index cb47ba6..1c03d86 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Run.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Query.Run.html @@ -53,15 +53,15 @@ data GraphQLError = GraphQLError ServerError [T.Text] -type GraphQLApp p qr mut sub m chn hs - = (ParseTypedDoc p qr mut sub, RunDocument p qr mut sub m chn hs) +type GraphQLApp p qr mut sub m chn hs + = (ParseTypedDoc p qr mut sub, RunDocument p qr mut sub m chn hs) runPipeline - :: forall qr mut sub p m chn hs. GraphQLApp p qr mut sub m chn hs - => (forall a. m a -> ServerErrorIO a) + :: forall qr mut sub p m chn hs. GraphQLApp p qr mut sub m chn hs + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m hs - -> Proxy qr -> Proxy mut -> Proxy sub + -> ServerT chn GQL.Field p m hs + -> Proxy qr -> Proxy mut -> Proxy sub -> Maybe T.Text -> VariableMapC -> [GQL.Definition] -> IO Aeson.Value runPipeline :: (forall a. m a -> ServerErrorIO a) @@ -74,16 +74,16 @@ -> VariableMapC -> [Definition] -> IO Value -runPipeline forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Proxy qr +runPipeline forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Proxy qr _ Proxy mut _ Proxy sub -_ Maybe Text -opName VariableMapC -vmap [Definition] -doc +_ Maybe Text +opName VariableMapC +vmap [Definition] +doc = case Maybe Text -> VariableMapC -> [Definition] @@ -93,23 +93,23 @@ forall (qr :: Maybe Symbol) (mut :: Maybe Symbol) (MonadError Text f, ParseTypedDoc p qr mut sub) => Maybe Text -> VariableMapC -> [Definition] -> f (Document p qr mut sub) -parseDoc @qr @mut @sub Maybe Text -opName VariableMapC -vmap [Definition] -doc of - Left Text -e -> Value -> IO Value +parseDoc @qr @mut @sub Maybe Text +opName VariableMapC +vmap [Definition] +doc of + Left Text +e -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> IO Value) -> Value -> IO Value forall a b. (a -> b) -> a -> b $ Text -> Value singleErrValue Text -e - Right (Document p qr mut sub -d :: Document p qr mut sub) -> do - (Value -data_, [GraphQLError] -errors) <- WriterT [GraphQLError] IO Value -> IO (Value, [GraphQLError]) +e + Right (Document p qr mut sub +d :: Document p qr mut sub) -> do + (Value +data_, [GraphQLError] +errors) <- WriterT [GraphQLError] IO Value -> IO (Value, [GraphQLError]) forall w (m :: * -> *) a. WriterT w m a -> m (a, w) runWriterT ((forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -126,12 +126,12 @@ RunDocument p qr mut sub m chn hs => -> Document p qr mut sub -> WriterT [GraphQLError] IO Value runDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p qr mut sub -d) +f RequestHeaders +req ServerT chn Field p m hs +svr Document p qr mut sub +d) case [GraphQLError] -errors of +errors of [] -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> IO Value) -> Value -> IO Value @@ -139,7 +139,7 @@ forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [ (Text "data", Value -data_) ] +data_) ] [GraphQLError] _ -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a @@ -148,19 +148,19 @@ forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [ (Text "data", Value -data_), (Text +data_), (Text "errors", (GraphQLError -> Value) -> [GraphQLError] -> Value forall a. (a -> Value) -> [a] -> Value Aeson.listValue GraphQLError -> Value errValue [GraphQLError] -errors) ] +errors) ] runSubscriptionPipeline - :: forall qr mut sub p m chn hs. GraphQLApp p qr mut sub m chn hs - => (forall a. m a -> ServerErrorIO a) + :: forall qr mut sub p m chn hs. GraphQLApp p qr mut sub m chn hs + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m hs - -> Proxy qr -> Proxy mut -> Proxy sub + -> ServerT chn GQL.Field p m hs + -> Proxy qr -> Proxy mut -> Proxy sub -> Maybe T.Text -> VariableMapC -> [GQL.Definition] -> ConduitT Aeson.Value Void IO () -> IO () @@ -175,17 +175,17 @@ forall a. (a -> Value) -> [a] -> Value -> [Definition] -> ConduitT Value Void IO () -> IO () -runSubscriptionPipeline forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Proxy qr +runSubscriptionPipeline forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Proxy qr _ Proxy mut _ Proxy sub -_ Maybe Text -opName VariableMapC -vmap [Definition] -doc ConduitT Value Void IO () -sink +_ Maybe Text +opName VariableMapC +vmap [Definition] +doc ConduitT Value Void IO () +sink = case Maybe Text -> VariableMapC -> [Definition] @@ -195,21 +195,21 @@ forall (qr :: Maybe Symbol) (mut :: Maybe Symbol) (MonadError Text f, ParseTypedDoc p qr mut sub) => Maybe Text -> VariableMapC -> [Definition] -> f (Document p qr mut sub) -parseDoc @qr @mut @sub Maybe Text -opName VariableMapC -vmap [Definition] -doc of - Left Text -e +parseDoc @qr @mut @sub Maybe Text +opName VariableMapC +vmap [Definition] +doc of + Left Text +e -> Text -> ConduitT Value Void IO () -> IO () forall (m :: * -> *). Monad m => Text -> ConduitM Value Void m () -> m () yieldSingleError Text -e ConduitT Value Void IO () -sink - Right (Document p qr mut sub -d :: Document p qr mut sub) +e ConduitT Value Void IO () +sink + Right (Document p qr mut sub +d :: Document p qr mut sub) -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs @@ -227,16 +227,16 @@ RunDocument p qr mut sub m chn hs => -> ConduitT Value Void IO () -> IO () runDocumentSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p qr mut sub -d ConduitT Value Void IO () -sink +f RequestHeaders +req ServerT chn Field p m hs +svr Document p qr mut sub +d ConduitT Value Void IO () +sink singleErrValue :: T.Text -> Aeson.Value singleErrValue :: Text -> Value -singleErrValue Text -e +singleErrValue Text +e = [Pair] -> Value Aeson.object [ (Text "errors", Array -> Value @@ -245,14 +245,14 @@ RunDocument p qr mut sub m chn hs => Aeson.object [ (Text "message", Text -> Value Aeson.String Text -e) ] ])] +e) ] ])] errValue :: GraphQLError -> Aeson.Value errValue :: GraphQLError -> Value errValue (GraphQLError (ServerError ServerErrorCode -_ String -msg) [Text] -path) +_ String +msg) [Text] +path) = [Pair] -> Value Aeson.object [ (Text @@ -261,20 +261,20 @@ RunDocument p qr mut sub m chn hs => forall a b. (a -> b) -> a -> b $ String -> Text T.pack String -msg) +msg) , (Text "path", [Text] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Text] -path) +path) ] -yieldSingleError :: Monad m - => T.Text -> ConduitM Aeson.Value Void m () -> m () +yieldSingleError :: Monad m + => T.Text -> ConduitM Aeson.Value Void m () -> m () yieldSingleError :: Text -> ConduitM Value Void m () -> m () -yieldSingleError Text -e ConduitM Value Void m () -sink = +yieldSingleError Text +e ConduitM Value Void m () +sink = ConduitT () Void m () -> m () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m () @@ -285,32 +285,32 @@ forall (m :: * -> *) mono i. mono -> ConduitT i (Element mono) m () yieldMany ([Text -> Value singleErrValue Text -e] :: [Aeson.Value]) ConduitT () Value m () +e] :: [Aeson.Value]) ConduitT () Value m () -> ConduitM Value Void m () -> ConduitT () Void m () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitM Value Void m () -sink +sink -yieldError :: Monad m +yieldError :: Monad m => ServerError -> [T.Text] - -> ConduitM Aeson.Value Void m () -> m () + -> ConduitM Aeson.Value Void m () -> m () yieldError :: ServerError -> [Text] -> ConduitM Value Void m () -> m () -yieldError ServerError -e [Text] -path ConduitM Value Void m () -sink = do - let val :: Value -val = [Pair] -> Value +yieldError ServerError +e [Text] +path ConduitM Value Void m () +sink = do + let val :: Value +val = [Pair] -> Value Aeson.object [ (Text "errors", (GraphQLError -> Value) -> [GraphQLError] -> Value forall a. (a -> Value) -> [a] -> Value Aeson.listValue GraphQLError -> Value errValue [ServerError -> [Text] -> GraphQLError GraphQLError ServerError -e [Text] -path]) ] +e [Text] +path]) ] ConduitT () Void m () -> m () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m () @@ -321,58 +321,58 @@ forall (m :: * -> *) mono i. mono -> ConduitT i (Element mono) m () yieldMany ([Item [Value] Value -val] :: [Aeson.Value]) ConduitT () Value m () +val] :: [Aeson.Value]) ConduitT () Value m () -> ConduitM Value Void m () -> ConduitT () Void m () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitM Value Void m () -sink +sink -class RunDocument (p :: Package') - (qr :: Maybe Symbol) - (mut :: Maybe Symbol) - (sub :: Maybe Symbol) - m chn hs where +class RunDocument (p :: Package') + (qr :: Maybe Symbol) + (mut :: Maybe Symbol) + (sub :: Maybe Symbol) + m chn hs where runDocument :: - (forall a. m a -> ServerErrorIO a) + (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m hs - -> Document p qr mut sub + -> ServerT chn GQL.Field p m hs + -> Document p qr mut sub -> WriterT [GraphQLError] IO Aeson.Value runDocumentSubscription :: - (forall a. m a -> ServerErrorIO a) + (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m hs - -> Document p qr mut sub + -> ServerT chn GQL.Field p m hs + -> Document p qr mut sub -> ConduitT Aeson.Value Void IO () -> IO () -instance - ( p ~ 'Package pname ss - , KnownSymbol qr - , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs - , MappingRight chn qr ~ () - , KnownSymbol mut - , RunQueryFindHandler m p hs chn ss (LookupService ss mut) hs - , MappingRight chn mut ~ () - , KnownSymbol sub - , RunQueryFindHandler m p hs chn ss (LookupService ss sub) hs - , MappingRight chn sub ~ () - , Intro.Introspect p ('Just qr) ('Just mut) ('Just sub) - ) => RunDocument p ('Just qr) ('Just mut) ('Just sub) m chn hs where - runDocument :: (forall a. m a -> ServerErrorIO a) +instance + ( p ~ 'Package pname ss + , KnownSymbol qr + , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs + , MappingRight chn qr ~ () + , KnownSymbol mut + , RunQueryFindHandler m p hs chn ss (LookupService ss mut) hs + , MappingRight chn mut ~ () + , KnownSymbol sub + , RunQueryFindHandler m p hs chn ss (LookupService ss sub) hs + , MappingRight chn sub ~ () + , Intro.Introspect p ('Just qr) ('Just mut) ('Just sub) + ) => RunDocument p ('Just qr) ('Just mut) ('Just sub) m chn hs where + runDocument :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) ('Just mut) ('Just sub) -> WriterT [GraphQLError] IO Value -runDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) ('Just mut) ('Just sub) -d - = let i :: Schema -i = Proxy p +runDocument forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) ('Just mut) ('Just sub) +d + = let i :: Schema +i = Proxy p -> Proxy ('Just qr) -> Proxy ('Just mut) -> Proxy ('Just sub) @@ -383,17 +383,17 @@ Introspect p qr mut sub => Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema Intro.introspect (Proxy p forall {k} (t :: k). Proxy t -Proxy @p) (Proxy ('Just qr) +Proxy @p) (Proxy ('Just qr) forall {k} (t :: k). Proxy t -Proxy @('Just qr)) (Proxy ('Just mut) +Proxy @('Just qr)) (Proxy ('Just mut) forall {k} (t :: k). Proxy t -Proxy @('Just mut)) (Proxy ('Just sub) +Proxy @('Just mut)) (Proxy ('Just sub) forall {k} (t :: k). Proxy t -Proxy @('Just sub)) +Proxy @('Just sub)) in case Document p ('Just qr) ('Just mut) ('Just sub) -d of - QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) -q +d of + QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) +q -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -418,14 +418,14 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -i ServerT chn Field p m hs -svr [] () ServiceQuery p ('Service qr qms) +f RequestHeaders +req Schema +i ServerT chn Field p m hs +svr [] () ServiceQuery p ('Service qr qms) ServiceQuery ('Package pname ss) (LookupService ss qr) -q - MutationDoc ServiceQuery ('Package pname ss) (LookupService ss mut) -q +q + MutationDoc ServiceQuery ('Package pname ss) (LookupService ss mut) +q -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -450,12 +450,12 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -i ServerT chn Field p m hs -svr [] () ServiceQuery p ('Service mut mms) +f RequestHeaders +req Schema +i ServerT chn Field p m hs +svr [] () ServiceQuery p ('Service mut mms) ServiceQuery ('Package pname ss) (LookupService ss mut) -q +q SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) _ -> Value -> WriterT [GraphQLError] IO Value @@ -466,17 +466,17 @@ forall a b. (a -> b) -> a -> b $ Text -> Value singleErrValue Text "cannot execute subscriptions in this wire" - runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) + runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) ('Just mut) ('Just sub) -> ConduitT Value Void IO () -> IO () -runDocumentSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr (SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) -d) +runDocumentSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr (SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) +d) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs @@ -501,16 +501,16 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ConduitT Value Void IO () -> IO () runSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr [] () OneMethodQuery p ('Service sub mms) +f RequestHeaders +req ServerT chn Field p m hs +svr [] () OneMethodQuery p ('Service sub mms) OneMethodQuery ('Package pname ss) (LookupService ss sub) -d - runDocumentSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) ('Just mut) ('Just sub) -d = (forall a. m a -> ServerErrorIO a) +d + runDocumentSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) ('Just mut) ('Just sub) +d = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) ('Just mut) ('Just sub) @@ -527,33 +527,33 @@ RunDocument p qr mut sub m chn hs => -> ConduitT Value Void IO () -> IO () yieldDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) ('Just mut) ('Just sub) -d +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) ('Just mut) ('Just sub) +d -instance - ( p ~ 'Package pname ss - , KnownSymbol qr - , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs - , MappingRight chn qr ~ () - , KnownSymbol mut - , RunQueryFindHandler m p hs chn ss (LookupService ss mut) hs - , MappingRight chn mut ~ () - , Intro.Introspect p ('Just qr) ('Just mut) 'Nothing - ) => RunDocument p ('Just qr) ('Just mut) 'Nothing m chn hs where - runDocument :: (forall a. m a -> ServerErrorIO a) +instance + ( p ~ 'Package pname ss + , KnownSymbol qr + , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs + , MappingRight chn qr ~ () + , KnownSymbol mut + , RunQueryFindHandler m p hs chn ss (LookupService ss mut) hs + , MappingRight chn mut ~ () + , Intro.Introspect p ('Just qr) ('Just mut) 'Nothing + ) => RunDocument p ('Just qr) ('Just mut) 'Nothing m chn hs where + runDocument :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) ('Just mut) 'Nothing -> WriterT [GraphQLError] IO Value -runDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) ('Just mut) 'Nothing -d - = let i :: Schema -i = Proxy p +runDocument forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) ('Just mut) 'Nothing +d + = let i :: Schema +i = Proxy p -> Proxy ('Just qr) -> Proxy ('Just mut) -> Proxy 'Nothing @@ -564,17 +564,17 @@ Introspect p qr mut sub => Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema Intro.introspect (Proxy p forall {k} (t :: k). Proxy t -Proxy @p) (Proxy ('Just qr) +Proxy @p) (Proxy ('Just qr) forall {k} (t :: k). Proxy t -Proxy @('Just qr)) (Proxy ('Just mut) +Proxy @('Just qr)) (Proxy ('Just mut) forall {k} (t :: k). Proxy t -Proxy @('Just mut)) (Proxy 'Nothing +Proxy @('Just mut)) (Proxy 'Nothing forall {k} (t :: k). Proxy t Proxy @'Nothing) in case Document p ('Just qr) ('Just mut) 'Nothing -d of - QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) -q +d of + QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) +q -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -599,14 +599,14 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -i ServerT chn Field p m hs -svr [] () ServiceQuery p ('Service qr qms) +f RequestHeaders +req Schema +i ServerT chn Field p m hs +svr [] () ServiceQuery p ('Service qr qms) ServiceQuery ('Package pname ss) (LookupService ss qr) -q - MutationDoc ServiceQuery ('Package pname ss) (LookupService ss mut) -q +q + MutationDoc ServiceQuery ('Package pname ss) (LookupService ss mut) +q -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -631,19 +631,19 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -i ServerT chn Field p m hs -svr [] () ServiceQuery p ('Service mut mms) +f RequestHeaders +req Schema +i ServerT chn Field p m hs +svr [] () ServiceQuery p ('Service mut mms) ServiceQuery ('Package pname ss) (LookupService ss mut) -q - runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) +q + runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) ('Just mut) 'Nothing -> ConduitT Value Void IO () -> IO () -runDocumentSubscription = (forall a. m a -> ServerErrorIO a) +runDocumentSubscription = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) ('Just mut) 'Nothing @@ -661,28 +661,28 @@ RunDocument p qr mut sub m chn hs => -> IO () yieldDocument -instance - ( p ~ 'Package pname ss - , KnownSymbol qr - , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs - , MappingRight chn qr ~ () - , KnownSymbol sub - , RunQueryFindHandler m p hs chn ss (LookupService ss sub) hs - , MappingRight chn sub ~ () - , Intro.Introspect p ('Just qr) 'Nothing ('Just sub) - ) => RunDocument p ('Just qr) 'Nothing ('Just sub) m chn hs where - runDocument :: (forall a. m a -> ServerErrorIO a) +instance + ( p ~ 'Package pname ss + , KnownSymbol qr + , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs + , MappingRight chn qr ~ () + , KnownSymbol sub + , RunQueryFindHandler m p hs chn ss (LookupService ss sub) hs + , MappingRight chn sub ~ () + , Intro.Introspect p ('Just qr) 'Nothing ('Just sub) + ) => RunDocument p ('Just qr) 'Nothing ('Just sub) m chn hs where + runDocument :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) 'Nothing ('Just sub) -> WriterT [GraphQLError] IO Value -runDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) 'Nothing ('Just sub) -d - = let i :: Schema -i = Proxy p +runDocument forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) 'Nothing ('Just sub) +d + = let i :: Schema +i = Proxy p -> Proxy ('Just qr) -> Proxy 'Nothing -> Proxy ('Just sub) @@ -693,17 +693,17 @@ Introspect p qr mut sub => Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema Intro.introspect (Proxy p forall {k} (t :: k). Proxy t -Proxy @p) (Proxy ('Just qr) +Proxy @p) (Proxy ('Just qr) forall {k} (t :: k). Proxy t -Proxy @('Just qr)) (Proxy 'Nothing +Proxy @('Just qr)) (Proxy 'Nothing forall {k} (t :: k). Proxy t Proxy @'Nothing) (Proxy ('Just sub) forall {k} (t :: k). Proxy t -Proxy @('Just sub)) +Proxy @('Just sub)) in case Document p ('Just qr) 'Nothing ('Just sub) -d of - QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) -q +d of + QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) +q -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -728,12 +728,12 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -i ServerT chn Field p m hs -svr [] () ServiceQuery p ('Service qr qms) +f RequestHeaders +req Schema +i ServerT chn Field p m hs +svr [] () ServiceQuery p ('Service qr qms) ServiceQuery ('Package pname ss) (LookupService ss qr) -q +q SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) _ -> Value -> WriterT [GraphQLError] IO Value @@ -744,17 +744,17 @@ forall a b. (a -> b) -> a -> b $ Text -> Value singleErrValue Text "cannot execute subscriptions in this wire" - runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) + runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) 'Nothing ('Just sub) -> ConduitT Value Void IO () -> IO () -runDocumentSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr (SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) -d) +runDocumentSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr (SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub) +d) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs @@ -779,16 +779,16 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ConduitT Value Void IO () -> IO () runSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr [] () OneMethodQuery p ('Service sub mms) +f RequestHeaders +req ServerT chn Field p m hs +svr [] () OneMethodQuery p ('Service sub mms) OneMethodQuery ('Package pname ss) (LookupService ss sub) -d - runDocumentSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) 'Nothing ('Just sub) -d = (forall a. m a -> ServerErrorIO a) +d + runDocumentSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) 'Nothing ('Just sub) +d = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) 'Nothing ('Just sub) @@ -805,30 +805,30 @@ RunDocument p qr mut sub m chn hs => -> ConduitT Value Void IO () -> IO () yieldDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) 'Nothing ('Just sub) -d +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) 'Nothing ('Just sub) +d -instance - ( p ~ 'Package pname ss - , KnownSymbol qr - , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs - , MappingRight chn qr ~ () - , Intro.Introspect p ('Just qr) 'Nothing 'Nothing - ) => RunDocument p ('Just qr) 'Nothing 'Nothing m chn hs where - runDocument :: (forall a. m a -> ServerErrorIO a) +instance + ( p ~ 'Package pname ss + , KnownSymbol qr + , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs + , MappingRight chn qr ~ () + , Intro.Introspect p ('Just qr) 'Nothing 'Nothing + ) => RunDocument p ('Just qr) 'Nothing 'Nothing m chn hs where + runDocument :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) 'Nothing 'Nothing -> WriterT [GraphQLError] IO Value -runDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p ('Just qr) 'Nothing 'Nothing -d - = let i :: Schema -i = Proxy p +runDocument forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p ('Just qr) 'Nothing 'Nothing +d + = let i :: Schema +i = Proxy p -> Proxy ('Just qr) -> Proxy 'Nothing -> Proxy 'Nothing -> Schema forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol). @@ -836,17 +836,17 @@ Introspect p qr mut sub => Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema Intro.introspect (Proxy p forall {k} (t :: k). Proxy t -Proxy @p) (Proxy ('Just qr) +Proxy @p) (Proxy ('Just qr) forall {k} (t :: k). Proxy t -Proxy @('Just qr)) (Proxy 'Nothing +Proxy @('Just qr)) (Proxy 'Nothing forall {k} (t :: k). Proxy t Proxy @'Nothing) (Proxy 'Nothing forall {k} (t :: k). Proxy t Proxy @'Nothing) in case Document p ('Just qr) 'Nothing 'Nothing -d of - QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) -q +d of + QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr) +q -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -871,19 +871,19 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -i ServerT chn Field p m hs -svr [] () ServiceQuery p ('Service qr qms) +f RequestHeaders +req Schema +i ServerT chn Field p m hs +svr [] () ServiceQuery p ('Service qr qms) ServiceQuery ('Package pname ss) (LookupService ss qr) -q - runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) +q + runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) 'Nothing 'Nothing -> ConduitT Value Void IO () -> IO () -runDocumentSubscription = (forall a. m a -> ServerErrorIO a) +runDocumentSubscription = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p ('Just qr) 'Nothing 'Nothing @@ -901,15 +901,15 @@ RunDocument p qr mut sub m chn hs => -> IO () yieldDocument -instance +instance ( TypeError ('Text "you need to have a query in your schema") - ) => RunDocument p 'Nothing mut sub m chn hs where - runDocument :: (forall a. m a -> ServerErrorIO a) + ) => RunDocument p 'Nothing mut sub m chn hs where + runDocument :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p 'Nothing mut sub -> WriterT [GraphQLError] IO Value -runDocument forall a. m a -> ServerErrorIO a +runDocument forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> ServerT chn Field p m hs @@ -918,13 +918,13 @@ RunDocument p qr mut sub m chn hs => forall a. HasCallStack => String -> a error String "this should never be called" - runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) + runDocumentSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs -> Document p 'Nothing mut sub -> ConduitT Value Void IO () -> IO () -runDocumentSubscription forall a. m a -> ServerErrorIO a +runDocumentSubscription forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> ServerT chn Field p m hs @@ -936,12 +936,12 @@ forall a. HasCallStack => String -> a "this should never be called" yieldDocument :: - forall p qr mut sub m chn hs. - RunDocument p qr mut sub m chn hs - => (forall a. m a -> ServerErrorIO a) + forall p qr mut sub m chn hs. + RunDocument p qr mut sub m chn hs + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m hs - -> Document p qr mut sub + -> ServerT chn GQL.Field p m hs + -> Document p qr mut sub -> ConduitT Aeson.Value Void IO () -> IO () yieldDocument :: (forall a. m a -> ServerErrorIO a) @@ -950,15 +950,15 @@ forall a. HasCallStack => String -> a -> Document p qr mut sub -> ConduitT Value Void IO () -> IO () -yieldDocument forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p qr mut sub -doc ConduitT Value Void IO () -sink = do - (Value -data_, [GraphQLError] -errors) <- WriterT [GraphQLError] IO Value -> IO (Value, [GraphQLError]) +yieldDocument forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p qr mut sub +doc ConduitT Value Void IO () +sink = do + (Value +data_, [GraphQLError] +errors) <- WriterT [GraphQLError] IO Value -> IO (Value, [GraphQLError]) forall w (m :: * -> *) a. WriterT w m a -> m (a, w) runWriterT ((forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -974,29 +974,29 @@ RunDocument p qr mut sub m chn hs => -> ServerT chn Field p m hs -> Document p qr mut sub -> WriterT [GraphQLError] IO Value -runDocument @p @qr @mut @sub @m @chn @hs forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -svr Document p qr mut sub -doc) - let (Value -val :: Aeson.Value) +runDocument @p @qr @mut @sub @m @chn @hs forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m hs +svr Document p qr mut sub +doc) + let (Value +val :: Aeson.Value) = case [GraphQLError] -errors of +errors of [] -> [Pair] -> Value Aeson.object [ (Text "data", Value -data_) ] +data_) ] [GraphQLError] _ -> [Pair] -> Value Aeson.object [ (Text "data", Value -data_), (Text +data_), (Text "errors", (GraphQLError -> Value) -> [GraphQLError] -> Value forall a. (a -> Value) -> [a] -> Value Aeson.listValue GraphQLError -> Value errValue [GraphQLError] -errors) ] +errors) ] ConduitT () Void IO () -> IO () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void IO () -> IO ()) @@ -1008,25 +1008,25 @@ forall (m :: * -> *) mono i. mono -> ConduitT i (Element mono) m () yieldMany ([Item [Value] Value -val] :: [Aeson.Value]) ConduitT () Value IO () +val] :: [Aeson.Value]) ConduitT () Value IO () -> ConduitT Value Void IO () -> ConduitT () Void IO () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitT Value Void IO () -sink +sink runQuery - :: forall m p s pname ss hs chn inh. - ( RunQueryFindHandler m p hs chn ss s hs - , p ~ 'Package pname ss - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) + :: forall m p s pname ss hs chn inh. + ( RunQueryFindHandler m p hs chn ss s hs + , p ~ 'Package pname ss + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> Intro.Schema -> ServerT chn GQL.Field p m hs + -> Intro.Schema -> ServerT chn GQL.Field p m hs -> [T.Text] - -> inh - -> ServiceQuery p s + -> inh + -> ServiceQuery p s -> WriterT [GraphQLError] IO Aeson.Value runQuery :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -1036,13 +1036,13 @@ ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r -> inh -> ServiceQuery p s -> WriterT [GraphQLError] IO Value -runQuery forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch whole :: ServerT chn Field p m hs -whole@(Services ServicesT chn Field s1 m hs -ss) [Text] -path = (forall a. m a -> ServerErrorIO a) +runQuery forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch whole :: ServerT chn Field p m hs +whole@(Services ServicesT chn Field s1 m hs +ss) [Text] +path = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m hs @@ -1070,24 +1070,24 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQueryFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m hs -whole [Text] -path ServicesT chn Field s1 m hs -ss +f RequestHeaders +req Schema +sch ServerT chn Field p m hs +whole [Text] +path ServicesT chn Field s1 m hs +ss runSubscription - :: forall m p s pname ss hs chn inh. - ( RunQueryFindHandler m p hs chn ss s hs - , p ~ 'Package pname ss - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) + :: forall m p s pname ss hs chn inh. + ( RunQueryFindHandler m p hs chn ss s hs + , p ~ 'Package pname ss + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m hs + -> ServerT chn GQL.Field p m hs -> [T.Text] - -> inh - -> OneMethodQuery p s + -> inh + -> OneMethodQuery p s -> ConduitT Aeson.Value Void IO () -> IO () runSubscription :: (forall a. m a -> ServerErrorIO a) @@ -1098,12 +1098,12 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> OneMethodQuery p s -> ConduitT Value Void IO () -> IO () -runSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req whole :: ServerT chn Field p m hs -whole@(Services ServicesT chn Field s1 m hs -ss) [Text] -path +runSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req whole :: ServerT chn Field p m hs +whole@(Services ServicesT chn Field s1 m hs +ss) [Text] +path = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m hs @@ -1132,66 +1132,66 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> ConduitT Value Void IO () -> IO () runSubscriptionFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m hs -whole [Text] -path ServicesT chn Field s1 m hs -ss +f RequestHeaders +req ServerT chn Field p m hs +whole [Text] +path ServicesT chn Field s1 m hs +ss -class RunQueryFindHandler m p whole chn ss s hs where - runQueryFindHandler - :: ( p ~ 'Package pname wholess - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) +class RunQueryFindHandler m p whole chn ss s hs where + runQueryFindHandler + :: ( p ~ 'Package pname wholess + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> Intro.Schema -> ServerT chn GQL.Field p m whole + -> Intro.Schema -> ServerT chn GQL.Field p m whole -> [T.Text] - -> ServicesT chn GQL.Field ss m hs - -> inh - -> ServiceQuery p s + -> ServicesT chn GQL.Field ss m hs + -> inh + -> ServiceQuery p s -> WriterT [GraphQLError] IO Aeson.Value - runSubscriptionFindHandler - :: ( p ~ 'Package pname wholess - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) + runSubscriptionFindHandler + :: ( p ~ 'Package pname wholess + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole + -> ServerT chn GQL.Field p m whole -> [T.Text] - -> ServicesT chn GQL.Field ss m hs - -> inh - -> OneMethodQuery p s + -> ServicesT chn GQL.Field ss m hs + -> inh + -> OneMethodQuery p s -> ConduitT Aeson.Value Void IO () -> IO () -class RunQueryOnFoundHandler m p whole chn (s :: Service snm mnm anm (TypeRef snm)) hs where - type ServiceName s :: snm - runQueryOnFoundHandler - :: ( p ~ 'Package pname wholess - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) +class RunQueryOnFoundHandler m p whole chn (s :: Service snm mnm anm (TypeRef snm)) hs where + type ServiceName s :: snm + runQueryOnFoundHandler + :: ( p ~ 'Package pname wholess + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> Intro.Schema -> ServerT chn GQL.Field p m whole + -> Intro.Schema -> ServerT chn GQL.Field p m whole -> [T.Text] - -> ServiceT chn GQL.Field s m hs - -> inh - -> ServiceQuery p s + -> ServiceT chn GQL.Field s m hs + -> inh + -> ServiceQuery p s -> WriterT [GraphQLError] IO Aeson.Value - runSubscriptionOnFoundHandler - :: ( p ~ 'Package pname wholess - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) + runSubscriptionOnFoundHandler + :: ( p ~ 'Package pname wholess + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole + -> ServerT chn GQL.Field p m whole -> [T.Text] - -> ServiceT chn GQL.Field s m hs - -> inh - -> OneMethodQuery p s + -> ServiceT chn GQL.Field s m hs + -> inh + -> OneMethodQuery p s -> ConduitT Aeson.Value Void IO () -> IO () -instance TypeError ('Text "Could not find handler for " ':<>: 'ShowType s) - => RunQueryFindHandler m p whole chn '[] s '[] where - runQueryFindHandler :: (forall a. m a -> ServerErrorIO a) +instance TypeError ('Text "Could not find handler for " ':<>: 'ShowType s) + => RunQueryFindHandler m p whole chn '[] s '[] where + runQueryFindHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1200,7 +1200,7 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> inh -> ServiceQuery p s -> WriterT [GraphQLError] IO Value -runQueryFindHandler forall a. m a -> ServerErrorIO a +runQueryFindHandler forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> Schema @@ -1213,7 +1213,7 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) forall a. HasCallStack => String -> a error String "this should never be called" - runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a) + runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -1222,7 +1222,7 @@ forall a. HasCallStack => String -> a -> OneMethodQuery p s -> ConduitT Value Void IO () -> IO () -runSubscriptionFindHandler forall a. m a -> ServerErrorIO a +runSubscriptionFindHandler forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> ServerT chn Field p m whole @@ -1235,10 +1235,10 @@ forall a. HasCallStack => String -> a forall a. HasCallStack => String -> a error String "this should never be called" -instance {-# OVERLAPPABLE #-} - RunQueryFindHandler m p whole chn ss s hs - => RunQueryFindHandler m p whole chn (other ': ss) s (h ': hs) where - runQueryFindHandler :: (forall a. m a -> ServerErrorIO a) +instance {-# OVERLAPPABLE #-} + RunQueryFindHandler m p whole chn ss s hs + => RunQueryFindHandler m p whole chn (other ': ss) s (h ': hs) where + runQueryFindHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1247,14 +1247,14 @@ forall a. HasCallStack => String -> a -> inh -> ServiceQuery p s -> WriterT [GraphQLError] IO Value -runQueryFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path (ServiceT chn Field svc m hs1 -_ :<&>: ServicesT chn Field rest m hss -that) +runQueryFindHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path (ServiceT chn Field svc m hs1 +_ :<&>: ServicesT chn Field rest m hss +that) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema @@ -1283,13 +1283,13 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQueryFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path ServicesT chn Field rest m hss -that - runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a) +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path ServicesT chn Field rest m hss +that + runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -1298,13 +1298,13 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> OneMethodQuery p s -> ConduitT Value Void IO () -> IO () -runSubscriptionFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (ServiceT chn Field svc m hs1 -_ :<&>: ServicesT chn Field rest m hss -that) +runSubscriptionFindHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (ServiceT chn Field svc m hs1 +_ :<&>: ServicesT chn Field rest m hss +that) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -1333,15 +1333,15 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> ConduitT Value Void IO () -> IO () runSubscriptionFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ServicesT chn Field rest m hss -that -instance {-# OVERLAPS #-} - (RunQueryOnFoundHandler m p whole chn s h) - => RunQueryFindHandler m p whole chn (s ': ss) s (h ': hs) where - runQueryFindHandler :: (forall a. m a -> ServerErrorIO a) +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ServicesT chn Field rest m hss +that +instance {-# OVERLAPS #-} + (RunQueryOnFoundHandler m p whole chn s h) + => RunQueryFindHandler m p whole chn (s ': ss) s (h ': hs) where + runQueryFindHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1350,13 +1350,13 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> inh -> ServiceQuery p s -> WriterT [GraphQLError] IO Value -runQueryFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path (ServiceT chn Field svc m hs1 -s :<&>: ServicesT chn Field rest m hss +runQueryFindHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path (ServiceT chn Field svc m hs1 +s :<&>: ServicesT chn Field rest m hss _) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -1385,13 +1385,13 @@ forall snm mnm anm (m :: * -> *) -> ServiceQuery p s -> WriterT [GraphQLError] IO Value runQueryOnFoundHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path ServiceT chn Field svc m hs1 -s - runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a) +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path ServiceT chn Field svc m hs1 +s + runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -1400,12 +1400,12 @@ forall snm mnm anm (m :: * -> *) -> OneMethodQuery p s -> ConduitT Value Void IO () -> IO () -runSubscriptionFindHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (ServiceT chn Field svc m hs1 -s :<&>: ServicesT chn Field rest m hss +runSubscriptionFindHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (ServiceT chn Field svc m hs1 +s :<&>: ServicesT chn Field rest m hss _) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -1434,16 +1434,16 @@ forall snm mnm anm (m :: * -> *) -> ConduitT Value Void IO () -> IO () runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ServiceT chn Field svc m hs1 -s +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ServiceT chn Field svc m hs1 +s -instance ( KnownName sname, RunMethod m p whole chn ('Service sname ms) ms h ) - => RunQueryOnFoundHandler m p whole chn ('Service sname ms) h where - type ServiceName ('Service sname ms) = sname - runQueryOnFoundHandler :: (forall a. m a -> ServerErrorIO a) +instance ( KnownName sname, RunMethod m p whole chn ('Service sname ms) ms h ) + => RunQueryOnFoundHandler m p whole chn ('Service sname ms) h where + type ServiceName ('Service sname ms) = sname + runQueryOnFoundHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1452,15 +1452,15 @@ forall snm mnm anm (m :: * -> *) -> inh -> ServiceQuery p ('Service sname ms) -> WriterT [GraphQLError] IO Value -runQueryOnFoundHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path (ProperSvc HandlersT chn Field (MappingRight chn sname) methods m h -this) inh -inh (ServiceQuery [OneMethodQuery p ('Service nm ms)] -queries) +runQueryOnFoundHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path (ProperSvc HandlersT chn Field (MappingRight chn sname) methods m h +this) inh +inh (ServiceQuery [OneMethodQuery p ('Service nm ms)] +queries) = [Pair] -> Value Aeson.object ([Pair] -> Value) -> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value @@ -1480,16 +1480,16 @@ forall (t :: * -> *) (m :: * -> *) a b. (a -> m b) -> t a -> m (t b) mapM OneMethodQuery p ('Service nm ms) -> WriterT [GraphQLError] IO (Maybe Pair) -runOneQuery [OneMethodQuery p ('Service nm ms)] -queries +runOneQuery [OneMethodQuery p ('Service nm ms)] +queries where -- if we include the signature we have to write -- an explicit type signature for 'runQueryFindHandler' - runOneQuery :: OneMethodQuery p ('Service nm ms) + runOneQuery :: OneMethodQuery p ('Service nm ms) -> WriterT [GraphQLError] IO (Maybe Pair) -runOneQuery (OneMethodQuery Maybe Text -nm NS (ChosenMethodQuery p) ms -args) +runOneQuery (OneMethodQuery Maybe Text +nm NS (ChosenMethodQuery p) ms +args) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -1519,27 +1519,27 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> NS (ChosenMethodQuery p) ms -> WriterT [GraphQLError] IO (Maybe Pair) runMethod forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole (Proxy ('Service sname ms) +f RequestHeaders +req ServerT chn Field p m whole +whole (Proxy ('Service sname ms) forall {k} (t :: k). Proxy t -Proxy @('Service sname ms)) [Text] -path Maybe Text -nm inh -inh HandlersT chn Field inh methods m h +Proxy @('Service sname ms)) [Text] +path Maybe Text +nm inh +inh HandlersT chn Field inh methods m h HandlersT chn Field (MappingRight chn sname) methods m h -this NS (ChosenMethodQuery p) methods +this NS (ChosenMethodQuery p) methods NS (ChosenMethodQuery p) ms -args +args -- handle __typename - runOneQuery (TypeNameQuery Maybe Text -nm) - = let realName :: Text -realName = Text -> Maybe Text -> Text + runOneQuery (TypeNameQuery Maybe Text +nm) + = let realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "__typename" Maybe Text -nm +nm in Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)) @@ -1548,7 +1548,7 @@ forall a b. (a -> b) -> a -> b $ Pair -> Maybe Pair forall a. a -> Maybe a Just (Text -realName, Text -> Value +realName, Text -> Value Aeson.String (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ String -> Text @@ -1560,58 +1560,58 @@ KnownName a => proxy a -> String nameVal (Proxy sname forall {k} (t :: k). Proxy t -Proxy @sname)) +Proxy @sname)) -- handle __schema - runOneQuery (SchemaQuery Maybe Text -nm [Selection] -ss) - = do let realName :: Text -realName = Text -> Maybe Text -> Text + runOneQuery (SchemaQuery Maybe Text +nm [Selection] +ss) + = do let realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "__schema" Maybe Text -nm +nm Pair -> Maybe Pair forall a. a -> Maybe a Just (Pair -> Maybe Pair) -> (Value -> Pair) -> Value -> Maybe Pair forall b c a. (b -> c) -> (a -> b) -> a -> c . (Text -realName, ) (Value -> Maybe Pair) +realName, ) (Value -> Maybe Pair) -> WriterT [GraphQLError] IO Value -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Text] -> Schema -> [Selection] -> WriterT [GraphQLError] IO Value runIntroSchema [Text] -path Schema -sch [Selection] -ss +path Schema +sch [Selection] +ss -- handle __type - runOneQuery (TypeQuery Maybe Text -nm Text -ty [Selection] -ss) - = do let realName :: Text -realName = Text -> Maybe Text -> Text + runOneQuery (TypeQuery Maybe Text +nm Text +ty [Selection] +ss) + = do let realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "__schema" Maybe Text -nm - Maybe Value -res <- [Text] +nm + Maybe Value +res <- [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path Schema -sch (Text -> Type +path Schema +sch (Text -> Type Intro.TypeRef Text -ty) [Selection] -ss +ty) [Selection] +ss case Maybe Value -res of - Just Value -val -> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) +res of + Just Value +val -> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)) -> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) @@ -1619,8 +1619,8 @@ forall a b. (a -> b) -> a -> b $ Pair -> Maybe Pair forall a. a -> Maybe a Just (Text -realName, Value -val) +realName, Value +val) Maybe Value Nothing -> do [GraphQLError] -> WriterT [GraphQLError] IO () forall w (m :: * -> *). MonadWriter w m => w -> m () @@ -1636,12 +1636,12 @@ forall a b. (a -> b) -> a -> b forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text -ty String -> String -> String +ty String -> String -> String forall a. Semigroup a => a -> a -> a <> String "'") [Text] -path] +path] Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)) @@ -1650,10 +1650,10 @@ forall a b. (a -> b) -> a -> b $ Pair -> Maybe Pair forall a. a -> Maybe a Just (Text -realName, Value +realName, Value Aeson.Null) -- subscriptions should only have one element - runSubscriptionOnFoundHandler :: (forall a. m a -> ServerErrorIO a) + runSubscriptionOnFoundHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -1662,16 +1662,16 @@ forall a. a -> Maybe a -> OneMethodQuery p ('Service sname ms) -> ConduitT Value Void IO () -> IO () -runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (ProperSvc HandlersT chn Field (MappingRight chn sname) methods m h -this) inh -inh (OneMethodQuery Maybe Text -nm NS (ChosenMethodQuery p) ms -args) ConduitT Value Void IO () -sink +runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (ProperSvc HandlersT chn Field (MappingRight chn sname) methods m h +this) inh +inh (OneMethodQuery Maybe Text +nm NS (ChosenMethodQuery p) ms +args) ConduitT Value Void IO () +sink = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -1703,38 +1703,38 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> ConduitT Value Void IO () -> IO () runMethodSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole (Proxy ('Service sname ms) +f RequestHeaders +req ServerT chn Field p m whole +whole (Proxy ('Service sname ms) forall {k} (t :: k). Proxy t -Proxy @('Service sname ms)) [Text] -path Maybe Text -nm inh -inh HandlersT chn Field inh methods m h +Proxy @('Service sname ms)) [Text] +path Maybe Text +nm inh +inh HandlersT chn Field inh methods m h HandlersT chn Field (MappingRight chn sname) methods m h -this NS (ChosenMethodQuery p) methods +this NS (ChosenMethodQuery p) methods NS (ChosenMethodQuery p) ms -args ConduitT Value Void IO () -sink +args ConduitT Value Void IO () +sink runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole _ [Text] _ ServiceT chn Field ('Service sname ms) m h _ inh -_ (TypeNameQuery Maybe Text -nm) ConduitT Value Void IO () -sink - = let realName :: Text -realName = Text -> Maybe Text -> Text +_ (TypeNameQuery Maybe Text +nm) ConduitT Value Void IO () +sink + = let realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "__typename" Maybe Text -nm - o :: Value -o = [Pair] -> Value +nm + o :: Value +o = [Pair] -> Value Aeson.object [(Text -realName, Text -> Value +realName, Text -> Value Aeson.String (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ String -> Text @@ -1746,7 +1746,7 @@ KnownName a => proxy a -> String nameVal (Proxy sname forall {k} (t :: k). Proxy t -Proxy @sname))] +Proxy @sname))] in ConduitT () Void IO () -> IO () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void IO () -> IO ()) @@ -1758,13 +1758,13 @@ forall (m :: * -> *) mono i. mono -> ConduitT i (Element mono) m () yieldMany ([Item [Value] Value -o] :: [Aeson.Value]) ConduitT () Value IO () +o] :: [Aeson.Value]) ConduitT () Value IO () -> ConduitT Value Void IO () -> ConduitT () Void IO () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitT Value Void IO () -sink +sink runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole @@ -1772,8 +1772,8 @@ ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r _ ServiceT chn Field ('Service sname ms) m h _ inh _ OneMethodQuery p ('Service sname ms) -_ ConduitT Value Void IO () -sink +_ ConduitT Value Void IO () +sink = ConduitT () Void IO () -> IO () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void IO () -> IO ()) @@ -1794,12 +1794,12 @@ forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitT Value Void IO () -sink +sink -instance ( KnownName sname, RunUnion m p whole chn elts ) - => RunQueryOnFoundHandler m p whole chn ('OneOf sname elts) h where - type ServiceName ('OneOf sname elts) = sname - runQueryOnFoundHandler :: (forall a. m a -> ServerErrorIO a) +instance ( KnownName sname, RunUnion m p whole chn elts ) + => RunQueryOnFoundHandler m p whole chn ('OneOf sname elts) h where + type ServiceName ('OneOf sname elts) = sname + runQueryOnFoundHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1808,17 +1808,17 @@ ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r -> inh -> ServiceQuery p ('OneOf sname elts) -> WriterT [GraphQLError] IO Value -runQueryOnFoundHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path (OneOfSvc MappingRight chn sname -> m (UnionChoice chn elts) -this) inh -inh (OneOfQuery NP (ChosenOneOfQuery p) elts -queries) - = do Either ServerError (UnionChoice chn elts) -res <- IO (Either ServerError (UnionChoice chn elts)) +runQueryOnFoundHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path (OneOfSvc MappingRight chn sname -> m (UnionChoice chn elts) +this) inh +inh (OneOfQuery NP (ChosenOneOfQuery p) elts +queries) + = do Either ServerError (UnionChoice chn elts) +res <- IO (Either ServerError (UnionChoice chn elts)) -> WriterT [GraphQLError] IO (Either ServerError (UnionChoice chn elts)) forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1840,24 +1840,24 @@ forall a b. (a -> b) -> a -> b $ m (UnionChoice chn elts) -> ExceptT ServerError IO (UnionChoice chn elts) forall a. m a -> ServerErrorIO a -f (m (UnionChoice chn elts) +f (m (UnionChoice chn elts) -> ExceptT ServerError IO (UnionChoice chn elts)) -> m (UnionChoice chn elts) -> ExceptT ServerError IO (UnionChoice chn elts) forall a b. (a -> b) -> a -> b $ MappingRight chn sname -> m (UnionChoice chn elts) -this inh +this inh MappingRight chn sname -inh +inh case Either ServerError (UnionChoice chn elts) -res of - Left ServerError -e -> [GraphQLError] -> WriterT [GraphQLError] IO () +res of + Left ServerError +e -> [GraphQLError] -> WriterT [GraphQLError] IO () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [ServerError -> [Text] -> GraphQLError GraphQLError ServerError -e [Text] -path] WriterT [GraphQLError] IO () +e [Text] +path] WriterT [GraphQLError] IO () -> WriterT [GraphQLError] IO Value -> WriterT [GraphQLError] IO Value forall (m :: * -> *) a b. Monad m => m a -> m b -> m b @@ -1865,8 +1865,8 @@ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b forall (f :: * -> *) a. Applicative f => a -> f a pure Value Aeson.Null - Right UnionChoice chn elts -x -> (forall a. m a -> ServerErrorIO a) + Right UnionChoice chn elts +x -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1887,15 +1887,15 @@ RunUnion m p whole chn elts => -> UnionChoice chn elts -> WriterT [GraphQLError] IO Value runUnion forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path NP (ChosenOneOfQuery p) elts -queries UnionChoice chn elts +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path NP (ChosenOneOfQuery p) elts +queries UnionChoice chn elts UnionChoice chn elts -x - runSubscriptionOnFoundHandler :: (forall a. m a -> ServerErrorIO a) +x + runSubscriptionOnFoundHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -1904,7 +1904,7 @@ UnionChoice chn elts -> OneMethodQuery p ('OneOf sname elts) -> ConduitT Value Void IO () -> IO () -runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a +runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole _ [Text] @@ -1918,18 +1918,18 @@ forall a. HasCallStack => String -> a error String "this should never happen" -class RunUnion m p whole chn elts where +class RunUnion m p whole chn elts where runUnion - :: (forall a. m a -> ServerErrorIO a) + :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> Intro.Schema -> ServerT chn GQL.Field p m whole + -> Intro.Schema -> ServerT chn GQL.Field p m whole -> [T.Text] - -> NP (ChosenOneOfQuery p) elts - -> UnionChoice chn elts + -> NP (ChosenOneOfQuery p) elts + -> UnionChoice chn elts -> WriterT [GraphQLError] IO Aeson.Value -instance RunUnion m p whole chn '[] where - runUnion :: (forall a. m a -> ServerErrorIO a) +instance RunUnion m p whole chn '[] where + runUnion :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1937,7 +1937,7 @@ forall a. HasCallStack => String -> a -> NP (ChosenOneOfQuery p) '[] -> UnionChoice chn '[] -> WriterT [GraphQLError] IO Value -runUnion forall a. m a -> ServerErrorIO a +runUnion forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> Schema @@ -1949,14 +1949,14 @@ forall a. HasCallStack => String -> a forall a. HasCallStack => String -> a error String "this should never happen" -instance forall m p pname s sname whole ss chn elts. - ( RunQueryFindHandler m p whole chn ss s whole - , p ~ 'Package pname ss - , s ~ LookupService ss sname - , ServiceName s ~ sname - , RunUnion m p whole chn elts ) - => RunUnion m p whole chn (sname ': elts) where - runUnion :: (forall a. m a -> ServerErrorIO a) +instance forall m p pname s sname whole ss chn elts. + ( RunQueryFindHandler m p whole chn ss s whole + , p ~ 'Package pname ss + , s ~ LookupService ss sname + , ServiceName s ~ sname + , RunUnion m p whole chn elts ) + => RunUnion m p whole chn (sname ': elts) where + runUnion :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> Schema -> ServerT chn Field p m whole @@ -1964,24 +1964,24 @@ forall a. HasCallStack => String -> a -> NP (ChosenOneOfQuery p) (sname : elts) -> UnionChoice chn (sname : elts) -> WriterT [GraphQLError] IO Value -runUnion forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path - (ChosenOneOfQuery (Proxy :: Proxy sname) ServiceQuery ('Package pname ss) (LookupService ss x) -q :* NP (ChosenOneOfQuery p) xs -rest) - choice :: UnionChoice chn (sname : elts) -choice@(UnionChoice (Proxy elt -Proxy :: Proxy other) MappingRight chn elt -v) +runUnion forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path + (ChosenOneOfQuery (Proxy :: Proxy sname) ServiceQuery ('Package pname ss) (LookupService ss x) +q :* NP (ChosenOneOfQuery p) xs +rest) + choice :: UnionChoice chn (sname : elts) +choice@(UnionChoice (Proxy elt +Proxy :: Proxy other) MappingRight chn elt +v) = case (Typeable sname, Typeable elt) => Maybe (sname :~: elt) forall {k} (a :: k) (b :: k). (Typeable a, Typeable b) => Maybe (a :~: b) -eqT @sname @other of +eqT @sname @other of Maybe (sname :~: elt) Nothing -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -2004,15 +2004,15 @@ RunUnion m p whole chn elts => -> UnionChoice chn elts -> WriterT [GraphQLError] IO Value runUnion forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole -whole [Text] -path NP (ChosenOneOfQuery p) xs -rest (UnionChoice chn (sname : elts) -> UnionChoice chn xs +f RequestHeaders +req Schema +sch ServerT chn Field p m whole +whole [Text] +path NP (ChosenOneOfQuery p) xs +rest (UnionChoice chn (sname : elts) -> UnionChoice chn xs forall a b. a -> b unsafeCoerce UnionChoice chn (sname : elts) -choice) +choice) Just sname :~: elt Refl -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders @@ -2037,43 +2037,43 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> inh -> ServiceQuery p s -> WriterT [GraphQLError] IO Value -runQuery @m @('Package pname ss) @(LookupService ss sname) @pname @ss @whole forall a. m a -> ServerErrorIO a -f RequestHeaders -req Schema -sch ServerT chn Field p m whole +runQuery @m @('Package pname ss) @(LookupService ss sname) @pname @ss @whole forall a. m a -> ServerErrorIO a +f RequestHeaders +req Schema +sch ServerT chn Field p m whole ServerT chn Field ('Package pname ss) m whole -whole [Text] -path MappingRight chn sname +whole [Text] +path MappingRight chn sname MappingRight chn elt -v ServiceQuery ('Package pname ss) (LookupService ss sname) +v ServiceQuery ('Package pname ss) (LookupService ss sname) ServiceQuery ('Package pname ss) (LookupService ss x) -q +q -class RunMethod m p whole chn s ms hs where - runMethod - :: ( p ~ 'Package pname wholess - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) +class RunMethod m p whole chn s ms hs where + runMethod + :: ( p ~ 'Package pname wholess + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole - -> Proxy s -> [T.Text] -> Maybe T.Text -> inh - -> HandlersT chn GQL.Field inh ms m hs - -> NS (ChosenMethodQuery p) ms + -> ServerT chn GQL.Field p m whole + -> Proxy s -> [T.Text] -> Maybe T.Text -> inh + -> HandlersT chn GQL.Field inh ms m hs + -> NS (ChosenMethodQuery p) ms -> WriterT [GraphQLError] IO (Maybe (T.Text, Aeson.Value)) - runMethodSubscription - :: ( p ~ 'Package pname wholess - , inh ~ MappingRight chn (ServiceName s) ) - => (forall a. m a -> ServerErrorIO a) + runMethodSubscription + :: ( p ~ 'Package pname wholess + , inh ~ MappingRight chn (ServiceName s) ) + => (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole - -> Proxy s -> [T.Text] -> Maybe T.Text -> inh - -> HandlersT chn GQL.Field inh ms m hs - -> NS (ChosenMethodQuery p) ms + -> ServerT chn GQL.Field p m whole + -> Proxy s -> [T.Text] -> Maybe T.Text -> inh + -> HandlersT chn GQL.Field inh ms m hs + -> NS (ChosenMethodQuery p) ms -> ConduitT Aeson.Value Void IO () -> IO () -instance RunMethod m p whole chn s '[] '[] where - runMethod :: (forall a. m a -> ServerErrorIO a) +instance RunMethod m p whole chn s '[] '[] where + runMethod :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> Proxy s @@ -2083,7 +2083,7 @@ ServiceQuery ('Package pname ss) (LookupService ss x) -> HandlersT chn Field inh '[] m '[] -> NS (ChosenMethodQuery p) '[] -> WriterT [GraphQLError] IO (Maybe Pair) -runMethod forall a. m a -> ServerErrorIO a +runMethod forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> ServerT chn Field p m whole @@ -2097,7 +2097,7 @@ ServiceQuery ('Package pname ss) (LookupService ss x) forall a. HasCallStack => String -> a error String "this should never be called" - runMethodSubscription :: (forall a. m a -> ServerErrorIO a) + runMethodSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> Proxy s @@ -2108,7 +2108,7 @@ forall a. HasCallStack => String -> a -> NS (ChosenMethodQuery p) '[] -> ConduitT Value Void IO () -> IO () -runMethodSubscription forall a. m a -> ServerErrorIO a +runMethodSubscription forall a. m a -> ServerErrorIO a _ = String -> RequestHeaders -> ServerT chn Field p m whole @@ -2123,13 +2123,13 @@ forall a. HasCallStack => String -> a forall a. HasCallStack => String -> a error String "this should never be called" -instance ( RunMethod m p whole chn s ms hs - , KnownName mname - , RunHandler m p whole chn args r h - , ReflectRpcInfo p s ('Method mname args r) ) - => RunMethod m p whole chn s ('Method mname args r ': ms) (h ': hs) where +instance ( RunMethod m p whole chn s ms hs + , KnownName mname + , RunHandler m p whole chn args r h + , ReflectRpcInfo p s ('Method mname args r) ) + => RunMethod m p whole chn s ('Method mname args r ': ms) (h ': hs) where -- handle normal methods - runMethod :: (forall a. m a -> ServerErrorIO a) + runMethod :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> Proxy s @@ -2139,21 +2139,21 @@ forall a. HasCallStack => String -> a -> HandlersT chn Field inh ('Method mname args r : ms) m (h : hs) -> NS (ChosenMethodQuery p) ('Method mname args r : ms) -> WriterT [GraphQLError] IO (Maybe Pair) -runMethod forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole Proxy s -_ [Text] -path Maybe Text -nm inh -inh (RpcInfo Field -> inh -> h -h :<||>: HandlersT chn Field inh ms m hs -_) (Z (ChosenMethodQuery Field -fld NP (ArgumentValue p) args -args ReturnQuery p r -ret)) +runMethod forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole Proxy s +_ [Text] +path Maybe Text +nm inh +inh (RpcInfo Field -> inh -> h +h :<||>: HandlersT chn Field inh ms m hs +_) (Z (ChosenMethodQuery Field +fld NP (ArgumentValue p) args +args ReturnQuery p r +ret)) = ((Text -realName ,) (Value -> Pair) -> Maybe Value -> Maybe Pair +realName ,) (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) (Maybe Value -> Maybe Pair) -> WriterT [GraphQLError] IO (Maybe Value) @@ -2182,21 +2182,21 @@ RunHandler m p whole chn args r h => -> ReturnQuery p r -> WriterT [GraphQLError] IO (Maybe Value) runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole ([Text] -path [Text] -> [Text] -> [Text] +f RequestHeaders +req ServerT chn Field p m whole +whole ([Text] +path [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] Text -realName]) (RpcInfo Field -> inh -> h -h RpcInfo Field -rpcInfo inh -inh) NP (ArgumentValue p) args -args ReturnQuery p r -ret - where realName :: Text -realName = Text -> Maybe Text -> Text +realName]) (RpcInfo Field -> inh -> h +h RpcInfo Field +rpcInfo inh +inh) NP (ArgumentValue p) args +args ReturnQuery p r +ret + where realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe (String -> Text T.pack (String -> Text) -> String -> Text @@ -2207,10 +2207,10 @@ KnownName a => proxy a -> String nameVal (Proxy mname forall {k} (t :: k). Proxy t -Proxy @mname)) Maybe Text -nm - rpcInfo :: RpcInfo Field -rpcInfo = Proxy p +Proxy @mname)) Maybe Text +nm + rpcInfo :: RpcInfo Field +rpcInfo = Proxy p -> Proxy s -> Proxy ('Method mname args r) -> RequestHeaders @@ -2223,24 +2223,24 @@ ReflectRpcInfo p s m => Proxy p -> Proxy s -> Proxy m -> RequestHeaders -> i -> RpcInfo i reflectRpcInfo (Proxy p forall {k} (t :: k). Proxy t -Proxy @p) (Proxy s +Proxy @p) (Proxy s forall {k} (t :: k). Proxy t -Proxy @s) (Proxy ('Method mname args r) +Proxy @s) (Proxy ('Method mname args r) forall {k} (t :: k). Proxy t -Proxy @('Method mname args r)) RequestHeaders -req Field -fld - runMethod forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole Proxy s -p [Text] -path Maybe Text -nm inh -inh (RpcInfo Field -> inh -> h -_ :<||>: HandlersT chn Field inh ms m hs -r) (S NS (ChosenMethodQuery p) xs -cont) +Proxy @('Method mname args r)) RequestHeaders +req Field +fld + runMethod forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole Proxy s +p [Text] +path Maybe Text +nm inh +inh (RpcInfo Field -> inh -> h +_ :<||>: HandlersT chn Field inh ms m hs +r) (S NS (ChosenMethodQuery p) xs +cont) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2270,16 +2270,16 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> NS (ChosenMethodQuery p) ms -> WriterT [GraphQLError] IO (Maybe Pair) runMethod forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole Proxy s -p [Text] -path Maybe Text -nm inh -inh HandlersT chn Field inh ms m hs -r NS (ChosenMethodQuery p) ms +f RequestHeaders +req ServerT chn Field p m whole +whole Proxy s +p [Text] +path Maybe Text +nm inh +inh HandlersT chn Field inh ms m hs +r NS (ChosenMethodQuery p) ms NS (ChosenMethodQuery p) xs -cont +cont runMethod forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole @@ -2294,7 +2294,7 @@ forall a. HasCallStack => String -> a error String "this should never happen" -- handle subscriptions - runMethodSubscription :: (forall a. m a -> ServerErrorIO a) + runMethodSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> Proxy s @@ -2305,20 +2305,20 @@ forall a. HasCallStack => String -> a -> NS (ChosenMethodQuery p) ('Method mname args r : ms) -> ConduitT Value Void IO () -> IO () -runMethodSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole Proxy s -_ [Text] -path Maybe Text -nm inh -inh (RpcInfo Field -> inh -> h -h :<||>: HandlersT chn Field inh ms m hs -_) (Z (ChosenMethodQuery Field -fld NP (ArgumentValue p) args -args ReturnQuery p r -ret)) ConduitT Value Void IO () -sink +runMethodSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole Proxy s +_ [Text] +path Maybe Text +nm inh +inh (RpcInfo Field -> inh -> h +h :<||>: HandlersT chn Field inh ms m hs +_) (Z (ChosenMethodQuery Field +fld NP (ArgumentValue p) args +args ReturnQuery p r +ret)) ConduitT Value Void IO () +sink = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2344,22 +2344,22 @@ RunHandler m p whole chn args r h => -> ConduitT Value Void IO () -> IO () runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole ([Text] -path [Text] -> [Text] -> [Text] +f RequestHeaders +req ServerT chn Field p m whole +whole ([Text] +path [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] Text -realName]) (RpcInfo Field -> inh -> h -h RpcInfo Field -rpcInfo inh -inh) NP (ArgumentValue p) args -args ReturnQuery p r -ret ConduitT Value Void IO () -sink - where realName :: Text -realName = Text -> Maybe Text -> Text +realName]) (RpcInfo Field -> inh -> h +h RpcInfo Field +rpcInfo inh +inh) NP (ArgumentValue p) args +args ReturnQuery p r +ret ConduitT Value Void IO () +sink + where realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe (String -> Text T.pack (String -> Text) -> String -> Text @@ -2370,10 +2370,10 @@ KnownName a => proxy a -> String nameVal (Proxy mname forall {k} (t :: k). Proxy t -Proxy @mname)) Maybe Text -nm - rpcInfo :: RpcInfo Field -rpcInfo = Proxy p +Proxy @mname)) Maybe Text +nm + rpcInfo :: RpcInfo Field +rpcInfo = Proxy p -> Proxy s -> Proxy ('Method mname args r) -> RequestHeaders @@ -2386,25 +2386,25 @@ ReflectRpcInfo p s m => Proxy p -> Proxy s -> Proxy m -> RequestHeaders -> i -> RpcInfo i reflectRpcInfo (Proxy p forall {k} (t :: k). Proxy t -Proxy @p) (Proxy s +Proxy @p) (Proxy s forall {k} (t :: k). Proxy t -Proxy @s) (Proxy ('Method mname args r) +Proxy @s) (Proxy ('Method mname args r) forall {k} (t :: k). Proxy t -Proxy @('Method mname args r)) RequestHeaders -req Field -fld - runMethodSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole Proxy s -p [Text] -path Maybe Text -nm inh -inh (RpcInfo Field -> inh -> h -_ :<||>: HandlersT chn Field inh ms m hs -r) (S NS (ChosenMethodQuery p) xs -cont) ConduitT Value Void IO () -sink +Proxy @('Method mname args r)) RequestHeaders +req Field +fld + runMethodSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole Proxy s +p [Text] +path Maybe Text +nm inh +inh (RpcInfo Field -> inh -> h +_ :<||>: HandlersT chn Field inh ms m hs +r) (S NS (ChosenMethodQuery p) xs +cont) ConduitT Value Void IO () +sink = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2436,17 +2436,17 @@ forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *) -> ConduitT Value Void IO () -> IO () runMethodSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole Proxy s -p [Text] -path Maybe Text -nm inh -inh HandlersT chn Field inh ms m hs -r NS (ChosenMethodQuery p) ms +f RequestHeaders +req ServerT chn Field p m whole +whole Proxy s +p [Text] +path Maybe Text +nm inh +inh HandlersT chn Field inh ms m hs +r NS (ChosenMethodQuery p) ms NS (ChosenMethodQuery p) xs -cont ConduitT Value Void IO () -sink +cont ConduitT Value Void IO () +sink runMethodSubscription forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole @@ -2462,31 +2462,31 @@ forall a. HasCallStack => String -> a error String "this should never happen" -class Handles chn args r m h - => RunHandler m p whole chn args r h where +class Handles chn args r m h + => RunHandler m p whole chn args r h where runHandler - :: (forall a. m a -> ServerErrorIO a) + :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole + -> ServerT chn GQL.Field p m whole -> [T.Text] - -> h - -> NP (ArgumentValue p) args - -> ReturnQuery p r + -> h + -> NP (ArgumentValue p) args + -> ReturnQuery p r -> WriterT [GraphQLError] IO (Maybe Aeson.Value) runHandlerSubscription - :: (forall a. m a -> ServerErrorIO a) + :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole + -> ServerT chn GQL.Field p m whole -> [T.Text] - -> h - -> NP (ArgumentValue p) args - -> ReturnQuery p r + -> h + -> NP (ArgumentValue p) args + -> ReturnQuery p r -> ConduitT Aeson.Value Void IO () -> IO () -instance (ArgumentConversion chn ref t, RunHandler m p whole chn rest r h) - => RunHandler m p whole chn ('ArgSingle aname ref ': rest) r (t -> h) where - runHandler :: (forall a. m a -> ServerErrorIO a) +instance (ArgumentConversion chn ref t, RunHandler m p whole chn rest r h) + => RunHandler m p whole chn ('ArgSingle aname ref ': rest) r (t -> h) where + runHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2494,14 +2494,14 @@ forall a. HasCallStack => String -> a -> NP (ArgumentValue p) ('ArgSingle aname ref : rest) -> ReturnQuery p r -> WriterT [GraphQLError] IO (Maybe Value) -runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path t -> h -h (ArgumentValue ArgumentValue' p r -one :* NP (ArgumentValue p) xs -rest) +runHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path t -> h +h (ArgumentValue ArgumentValue' p r +one :* NP (ArgumentValue p) xs +rest) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2525,21 +2525,21 @@ RunHandler m p whole chn args r h => -> ReturnQuery p r -> WriterT [GraphQLError] IO (Maybe Value) runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (t -> h -h (Proxy chn -> ArgumentValue' p r -> t +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (t -> h +h (Proxy chn -> ArgumentValue' p r -> t forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm} {anm} (p :: Package snm mnm anm (TypeRef snm)). ArgumentConversion chn ref t => Proxy chn -> ArgumentValue' p ref -> t convertArg (Proxy chn forall {k} (t :: k). Proxy t -Proxy @chn) ArgumentValue' p r -one)) NP (ArgumentValue p) xs -rest - runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) +Proxy @chn) ArgumentValue' p r +one)) NP (ArgumentValue p) xs +rest + runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2548,14 +2548,14 @@ forall {k} (t :: k). Proxy t -> ReturnQuery p r -> ConduitT Value Void IO () -> IO () -runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path t -> h -h (ArgumentValue ArgumentValue' p r -one :* NP (ArgumentValue p) xs -rest) +runHandlerSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path t -> h +h (ArgumentValue ArgumentValue' p r +one :* NP (ArgumentValue p) xs +rest) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2581,26 +2581,26 @@ RunHandler m p whole chn args r h => -> ConduitT Value Void IO () -> IO () runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (t -> h -h (Proxy chn -> ArgumentValue' p r -> t +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (t -> h +h (Proxy chn -> ArgumentValue' p r -> t forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm} {anm} (p :: Package snm mnm anm (TypeRef snm)). ArgumentConversion chn ref t => Proxy chn -> ArgumentValue' p ref -> t convertArg (Proxy chn forall {k} (t :: k). Proxy t -Proxy @chn) ArgumentValue' p r -one)) NP (ArgumentValue p) xs -rest -instance ( MonadError ServerError m - , FromRef chn ref t - , ArgumentConversion chn ('ListRef ref) [t] - , RunHandler m p whole chn rest r h ) - => RunHandler m p whole chn ('ArgStream aname ref ': rest) r (ConduitT () t m () -> h) where - runHandler :: (forall a. m a -> ServerErrorIO a) +Proxy @chn) ArgumentValue' p r +one)) NP (ArgumentValue p) xs +rest +instance ( MonadError ServerError m + , FromRef chn ref t + , ArgumentConversion chn ('ListRef ref) [t] + , RunHandler m p whole chn rest r h ) + => RunHandler m p whole chn ('ArgStream aname ref ': rest) r (ConduitT () t m () -> h) where + runHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2608,24 +2608,24 @@ forall {k} (t :: k). Proxy t -> NP (ArgumentValue p) ('ArgStream aname ref : rest) -> ReturnQuery p r -> WriterT [GraphQLError] IO (Maybe Value) -runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ConduitT () t m () -> h -h (ArgumentStream ArgumentValue' p ('ListRef r) -lst :* NP (ArgumentValue p) xs -rest) - = let [t] -converted :: [t] = Proxy chn -> ArgumentValue' p ('ListRef r) -> [t] +runHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ConduitT () t m () -> h +h (ArgumentStream ArgumentValue' p ('ListRef r) +lst :* NP (ArgumentValue p) xs +rest) + = let [t] +converted :: [t] = Proxy chn -> ArgumentValue' p ('ListRef r) -> [t] forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm} {anm} (p :: Package snm mnm anm (TypeRef snm)). ArgumentConversion chn ref t => Proxy chn -> ArgumentValue' p ref -> t convertArg (Proxy chn forall {k} (t :: k). Proxy t -Proxy @chn) ArgumentValue' p ('ListRef r) -lst +Proxy @chn) ArgumentValue' p ('ListRef r) +lst in (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2649,18 +2649,18 @@ RunHandler m p whole chn args r h => -> ReturnQuery p r -> WriterT [GraphQLError] IO (Maybe Value) runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (ConduitT () t m () -> h -h ([t] -> ConduitT () (Element [t]) m () +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (ConduitT () t m () -> h +h ([t] -> ConduitT () (Element [t]) m () forall (m :: * -> *) mono i. (Monad m, MonoFoldable mono) => mono -> ConduitT i (Element mono) m () yieldMany [t] -converted)) NP (ArgumentValue p) xs -rest - runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) +converted)) NP (ArgumentValue p) xs +rest + runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2669,25 +2669,25 @@ mono -> ConduitT i (Element mono) m () -> ReturnQuery p r -> ConduitT Value Void IO () -> IO () -runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ConduitT () t m () -> h -h (ArgumentStream ArgumentValue' p ('ListRef r) -lst :* NP (ArgumentValue p) xs -rest) ReturnQuery p r -sink - = let [t] -converted :: [t] = Proxy chn -> ArgumentValue' p ('ListRef r) -> [t] +runHandlerSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ConduitT () t m () -> h +h (ArgumentStream ArgumentValue' p ('ListRef r) +lst :* NP (ArgumentValue p) xs +rest) ReturnQuery p r +sink + = let [t] +converted :: [t] = Proxy chn -> ArgumentValue' p ('ListRef r) -> [t] forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm} {anm} (p :: Package snm mnm anm (TypeRef snm)). ArgumentConversion chn ref t => Proxy chn -> ArgumentValue' p ref -> t convertArg (Proxy chn forall {k} (t :: k). Proxy t -Proxy @chn) ArgumentValue' p ('ListRef r) -lst +Proxy @chn) ArgumentValue' p ('ListRef r) +lst in (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -2713,21 +2713,21 @@ RunHandler m p whole chn args r h => -> ConduitT Value Void IO () -> IO () runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (ConduitT () t m () -> h -h ([t] -> ConduitT () (Element [t]) m () +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (ConduitT () t m () -> h +h ([t] -> ConduitT () (Element [t]) m () forall (m :: * -> *) mono i. (Monad m, MonoFoldable mono) => mono -> ConduitT i (Element mono) m () yieldMany [t] -converted)) NP (ArgumentValue p) xs -rest ReturnQuery p r -sink -instance (MonadError ServerError m) - => RunHandler m p whole chn '[] 'RetNothing (m ()) where - runHandler :: (forall a. m a -> ServerErrorIO a) +converted)) NP (ArgumentValue p) xs +rest ReturnQuery p r +sink +instance (MonadError ServerError m) + => RunHandler m p whole chn '[] 'RetNothing (m ()) where + runHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2735,16 +2735,16 @@ mono -> ConduitT i (Element mono) m () -> NP (ArgumentValue p) '[] -> ReturnQuery p 'RetNothing -> WriterT [GraphQLError] IO (Maybe Value) -runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -_req ServerT chn Field p m whole -_ [Text] -path m () -h NP (ArgumentValue p) '[] +runHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +_req ServerT chn Field p m whole +_ [Text] +path m () +h NP (ArgumentValue p) '[] Nil ReturnQuery p 'RetNothing _ = do - Either ServerError () -res <- IO (Either ServerError ()) + Either ServerError () +res <- IO (Either ServerError ()) -> WriterT [GraphQLError] IO (Either ServerError ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either ServerError ()) @@ -2756,10 +2756,10 @@ forall a b. (a -> b) -> a -> b forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (m () -> ExceptT ServerError IO () forall a. m a -> ServerErrorIO a -f m () -h) +f m () +h) case Either ServerError () -res of +res of Right () _ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a @@ -2770,13 +2770,13 @@ forall a b. (a -> b) -> a -> b forall a. a -> Maybe a Just Value Aeson.Null - Left ServerError -e -> [GraphQLError] -> WriterT [GraphQLError] IO () + Left ServerError +e -> [GraphQLError] -> WriterT [GraphQLError] IO () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [ServerError -> [Text] -> GraphQLError GraphQLError ServerError -e [Text] -path] WriterT [GraphQLError] IO () +e [Text] +path] WriterT [GraphQLError] IO () -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Value) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b @@ -2785,7 +2785,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) + runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2794,17 +2794,17 @@ forall a. Maybe a -> ReturnQuery p 'RetNothing -> ConduitT Value Void IO () -> IO () -runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -_req ServerT chn Field p m whole -_ [Text] -path m () -h NP (ArgumentValue p) '[] +runHandlerSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +_req ServerT chn Field p m whole +_ [Text] +path m () +h NP (ArgumentValue p) '[] Nil ReturnQuery p 'RetNothing -_ ConduitT Value Void IO () -sink = do - Either ServerError () -res <- IO (Either ServerError ()) -> IO (Either ServerError ()) +_ ConduitT Value Void IO () +sink = do + Either ServerError () +res <- IO (Either ServerError ()) -> IO (Either ServerError ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either ServerError ()) -> IO (Either ServerError ())) -> IO (Either ServerError ()) -> IO (Either ServerError ()) @@ -2813,10 +2813,10 @@ forall a b. (a -> b) -> a -> b forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (m () -> ExceptT ServerError IO () forall a. m a -> ServerErrorIO a -f m () -h) +f m () +h) case Either ServerError () -res of +res of Right () _ -> ConduitT () Void IO () -> IO () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r @@ -2833,19 +2833,19 @@ forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitT Value Void IO () -sink - Left ServerError -e -> ServerError -> [Text] -> ConduitT Value Void IO () -> IO () +sink + Left ServerError +e -> ServerError -> [Text] -> ConduitT Value Void IO () -> IO () forall (m :: * -> *). Monad m => ServerError -> [Text] -> ConduitM Value Void m () -> m () yieldError ServerError -e [Text] -path ConduitT Value Void IO () -sink -instance (MonadError ServerError m, ResultConversion m p whole chn r l) - => RunHandler m p whole chn '[] ('RetSingle r) (m l) where - runHandler :: (forall a. m a -> ServerErrorIO a) +e [Text] +path ConduitT Value Void IO () +sink +instance (MonadError ServerError m, ResultConversion m p whole chn r l) + => RunHandler m p whole chn '[] ('RetSingle r) (m l) where + runHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2853,16 +2853,16 @@ ServerError -> [Text] -> ConduitM Value Void m () -> m () -> NP (ArgumentValue p) '[] -> ReturnQuery p ('RetSingle r) -> WriterT [GraphQLError] IO (Maybe Value) -runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path m l -h NP (ArgumentValue p) '[] -Nil (RSingle ReturnQuery' p r -q) = do - Either ServerError l -res <- IO (Either ServerError l) +runHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path m l +h NP (ArgumentValue p) '[] +Nil (RSingle ReturnQuery' p r +q) = do + Either ServerError l +res <- IO (Either ServerError l) -> WriterT [GraphQLError] IO (Either ServerError l) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either ServerError l) @@ -2874,12 +2874,12 @@ forall a b. (a -> b) -> a -> b forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (m l -> ExceptT ServerError IO l forall a. m a -> ServerErrorIO a -f m l -h) +f m l +h) case Either ServerError l -res of - Right l -v -> (forall a. m a -> ServerErrorIO a) +res of + Right l +v -> (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2898,19 +2898,19 @@ ResultConversion m p whole chn r l => -> l -> WriterT [GraphQLError] IO (Maybe Value) convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ReturnQuery' p r -q l -v - Left ServerError -e -> [GraphQLError] -> WriterT [GraphQLError] IO () +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ReturnQuery' p r +q l +v + Left ServerError +e -> [GraphQLError] -> WriterT [GraphQLError] IO () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [ServerError -> [Text] -> GraphQLError GraphQLError ServerError -e [Text] -path] WriterT [GraphQLError] IO () +e [Text] +path] WriterT [GraphQLError] IO () -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Value) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b @@ -2919,7 +2919,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) + runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -2928,17 +2928,17 @@ forall a. Maybe a -> ReturnQuery p ('RetSingle r) -> ConduitT Value Void IO () -> IO () -runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path m l -h NP (ArgumentValue p) '[] -Nil (RSingle ReturnQuery' p r -q) ConduitT Value Void IO () -sink = do - Either ServerError l -res <- IO (Either ServerError l) -> IO (Either ServerError l) +runHandlerSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path m l +h NP (ArgumentValue p) '[] +Nil (RSingle ReturnQuery' p r +q) ConduitT Value Void IO () +sink = do + Either ServerError l +res <- IO (Either ServerError l) -> IO (Either ServerError l) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either ServerError l) -> IO (Either ServerError l)) -> IO (Either ServerError l) -> IO (Either ServerError l) @@ -2947,16 +2947,16 @@ forall a b. (a -> b) -> a -> b forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (m l -> ExceptT ServerError IO l forall a. m a -> ServerErrorIO a -f m l -h) - Value -val <- case Either ServerError l -res of - Right l -v -> do - (Maybe Value -data_, [GraphQLError] -errors) <- WriterT [GraphQLError] IO (Maybe Value) +f m l +h) + Value +val <- case Either ServerError l +res of + Right l +v -> do + (Maybe Value +data_, [GraphQLError] +errors) <- WriterT [GraphQLError] IO (Maybe Value) -> IO (Maybe Value, [GraphQLError]) forall w (m :: * -> *) a. WriterT w m a -> m (a, w) runWriterT ((forall a. m a -> ServerErrorIO a) @@ -2978,14 +2978,14 @@ ResultConversion m p whole chn r l => -> l -> WriterT [GraphQLError] IO (Maybe Value) convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ReturnQuery' p r -q l -v) +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ReturnQuery' p r +q l +v) case [GraphQLError] -errors of +errors of [] -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> IO Value) -> Value -> IO Value @@ -2996,7 +2996,7 @@ forall a b. (a -> b) -> a -> b forall a. a -> Maybe a -> a fromMaybe Value Aeson.Null Maybe Value -data_) ] +data_) ] [GraphQLError] _ -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a @@ -3008,15 +3008,15 @@ forall a b. (a -> b) -> a -> b forall a. a -> Maybe a -> a fromMaybe Value Aeson.Null Maybe Value -data_) +data_) , (Text "errors", (GraphQLError -> Value) -> [GraphQLError] -> Value forall a. (a -> Value) -> [a] -> Value Aeson.listValue GraphQLError -> Value errValue [GraphQLError] -errors) ] - Left ServerError -e -> Value -> IO Value +errors) ] + Left ServerError +e -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> IO Value) -> Value -> IO Value forall a b. (a -> b) -> a -> b @@ -3027,8 +3027,8 @@ forall a. (a -> Value) -> [a] -> Value Aeson.listValue GraphQLError -> Value errValue [ServerError -> [Text] -> GraphQLError GraphQLError ServerError -e [Text] -path]) ] +e [Text] +path]) ] ConduitT () Void IO () -> IO () forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void IO () -> IO ()) @@ -3040,16 +3040,16 @@ forall (m :: * -> *) mono i. mono -> ConduitT i (Element mono) m () yieldMany ([Item [Value] Value -val] :: [Aeson.Value]) ConduitT () Value IO () +val] :: [Aeson.Value]) ConduitT () Value IO () -> ConduitT Value Void IO () -> ConduitT () Void IO () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitT Value Void IO () -sink -instance (MonadIO m, MonadError ServerError m, ResultConversion m p whole chn r l) - => RunHandler m p whole chn '[] ('RetStream r) (ConduitT l Void m () -> m ()) where - runHandler :: (forall a. m a -> ServerErrorIO a) +sink +instance (MonadIO m, MonadError ServerError m, ResultConversion m p whole chn r l) + => RunHandler m p whole chn '[] ('RetStream r) (ConduitT l Void m () -> m ()) where + runHandler :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -3057,22 +3057,22 @@ ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r -> NP (ArgumentValue p) '[] -> ReturnQuery p ('RetStream r) -> WriterT [GraphQLError] IO (Maybe Value) -runHandler forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ConduitT l Void m () -> m () -h NP (ArgumentValue p) '[] -Nil (RStream ReturnQuery' p r -q) = do - TMQueue l -queue <- IO (TMQueue l) -> WriterT [GraphQLError] IO (TMQueue l) +runHandler forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ConduitT l Void m () -> m () +h NP (ArgumentValue p) '[] +Nil (RStream ReturnQuery' p r +q) = do + TMQueue l +queue <- IO (TMQueue l) -> WriterT [GraphQLError] IO (TMQueue l) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMQueue l) forall a. IO (TMQueue a) newTMQueueIO - Either ServerError () -res <- IO (Either ServerError ()) + Either ServerError () +res <- IO (Either ServerError ()) -> WriterT [GraphQLError] IO (Either ServerError ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either ServerError ()) @@ -3087,22 +3087,22 @@ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) forall a b. (a -> b) -> a -> b $ m () -> ExceptT ServerError IO () forall a. m a -> ServerErrorIO a -f (m () -> ExceptT ServerError IO ()) +f (m () -> ExceptT ServerError IO ()) -> m () -> ExceptT ServerError IO () forall a b. (a -> b) -> a -> b $ ConduitT l Void m () -> m () -h (TMQueue l -> ConduitT l Void m () +h (TMQueue l -> ConduitT l Void m () forall (m :: * -> *) a z. MonadIO m => TMQueue a -> ConduitT a z m () sinkTMQueue TMQueue l -queue) +queue) case Either ServerError () -res of +res of Right () _ -> do - [l] -info <- ConduitT () Void (WriterT [GraphQLError] IO) [l] + [l] +info <- ConduitT () Void (WriterT [GraphQLError] IO) [l] -> WriterT [GraphQLError] IO [l] forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void (WriterT [GraphQLError] IO) [l] @@ -3115,7 +3115,7 @@ forall (m :: * -> *) a z. MonadIO m => TMQueue a -> ConduitT z a m () sourceTMQueue TMQueue l -queue ConduitT () l (WriterT [GraphQLError] IO) () +queue ConduitT () l (WriterT [GraphQLError] IO) () -> ConduitM l Void (WriterT [GraphQLError] IO) [l] -> ConduitT () Void (WriterT [GraphQLError] IO) [l] forall (m :: * -> *) a b c r. @@ -3164,18 +3164,18 @@ ResultConversion m p whole chn r l => -> l -> WriterT [GraphQLError] IO (Maybe Value) convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ReturnQuery' p r -q) [l] -info - Left ServerError -e -> [GraphQLError] -> WriterT [GraphQLError] IO () +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ReturnQuery' p r +q) [l] +info + Left ServerError +e -> [GraphQLError] -> WriterT [GraphQLError] IO () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [ServerError -> [Text] -> GraphQLError GraphQLError ServerError -e []] WriterT [GraphQLError] IO () +e []] WriterT [GraphQLError] IO () -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Value) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b @@ -3184,7 +3184,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) + runHandlerSubscription :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] @@ -3193,17 +3193,17 @@ forall a. Maybe a -> ReturnQuery p ('RetStream r) -> ConduitT Value Void IO () -> IO () -runHandlerSubscription forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ConduitT l Void m () -> m () -h NP (ArgumentValue p) '[] -Nil (RStream ReturnQuery' p r -q) ConduitT Value Void IO () -sink = do - Either ServerError () -res <- IO (Either ServerError ()) -> IO (Either ServerError ()) +runHandlerSubscription forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ConduitT l Void m () -> m () +h NP (ArgumentValue p) '[] +Nil (RStream ReturnQuery' p r +q) ConduitT Value Void IO () +sink = do + Either ServerError () +res <- IO (Either ServerError ()) -> IO (Either ServerError ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either ServerError ()) -> IO (Either ServerError ())) -> IO (Either ServerError ()) -> IO (Either ServerError ()) @@ -3215,11 +3215,11 @@ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) forall a b. (a -> b) -> a -> b $ m () -> ExceptT ServerError IO () forall a. m a -> ServerErrorIO a -f (m () -> ExceptT ServerError IO ()) +f (m () -> ExceptT ServerError IO ()) -> m () -> ExceptT ServerError IO () forall a b. (a -> b) -> a -> b $ ConduitT l Void m () -> m () -h +h ((forall a. IO a -> m a) -> ConduitT l Void IO () -> ConduitT l Void m () forall (m :: * -> *) (n :: * -> *) i o r. @@ -3236,34 +3236,34 @@ Monad m => (i1 -> m i2) -> (i2 -> m (Maybe i1)) -> ConduitT i2 o m r -> ConduitT i1 o m r mapInputM l -> IO Value -convert (String -> Value -> IO (Maybe l) +convert (String -> Value -> IO (Maybe l) forall a. HasCallStack => String -> a error String "this should not be called") ConduitT Value Void IO () -sink)) +sink)) case Either ServerError () -res of +res of Right () _ -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () - Left ServerError -e -> ServerError -> [Text] -> ConduitT Value Void IO () -> IO () + Left ServerError +e -> ServerError -> [Text] -> ConduitT Value Void IO () -> IO () forall (m :: * -> *). Monad m => ServerError -> [Text] -> ConduitM Value Void m () -> m () yieldError ServerError -e [Text] -path ConduitT Value Void IO () -sink +e [Text] +path ConduitT Value Void IO () +sink where - convert :: l -> IO Aeson.Value - convert :: l -> IO Value -convert l -v = do - (Maybe Value -data_, [GraphQLError] -errors) <- WriterT [GraphQLError] IO (Maybe Value) + convert :: l -> IO Aeson.Value + convert :: l -> IO Value +convert l +v = do + (Maybe Value +data_, [GraphQLError] +errors) <- WriterT [GraphQLError] IO (Maybe Value) -> IO (Maybe Value, [GraphQLError]) forall w (m :: * -> *) a. WriterT w m a -> m (a, w) runWriterT ((forall a. m a -> ServerErrorIO a) @@ -3285,14 +3285,14 @@ ResultConversion m p whole chn r l => -> l -> WriterT [GraphQLError] IO (Maybe Value) convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ReturnQuery' p r -q l -v) +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ReturnQuery' p r +q l +v) case [GraphQLError] -errors of +errors of [] -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> IO Value) -> Value -> IO Value @@ -3303,7 +3303,7 @@ forall a b. (a -> b) -> a -> b forall a. a -> Maybe a -> a fromMaybe Value Aeson.Null Maybe Value -data_) ] +data_) ] [GraphQLError] _ -> Value -> IO Value forall (f :: * -> *) a. Applicative f => a -> f a @@ -3315,85 +3315,85 @@ forall a b. (a -> b) -> a -> b forall a. a -> Maybe a -> a fromMaybe Value Aeson.Null Maybe Value -data_) +data_) , (Text "errors", (GraphQLError -> Value) -> [GraphQLError] -> Value forall a. (a -> Value) -> [a] -> Value Aeson.listValue GraphQLError -> Value errValue [GraphQLError] -errors) ] +errors) ] -class FromRef chn ref t - => ArgumentConversion chn ref t where - convertArg :: Proxy chn -> ArgumentValue' p ref -> t -instance ArgumentConversion chn ('PrimitiveRef s) s where - convertArg :: Proxy chn -> ArgumentValue' p ('PrimitiveRef s) -> s -convertArg Proxy chn -_ (ArgPrimitive t -x) = s +class FromRef chn ref t + => ArgumentConversion chn ref t where + convertArg :: Proxy chn -> ArgumentValue' p ref -> t +instance ArgumentConversion chn ('PrimitiveRef s) s where + convertArg :: Proxy chn -> ArgumentValue' p ('PrimitiveRef s) -> s +convertArg Proxy chn +_ (ArgPrimitive t +x) = s t -x -instance FromSchema sch sty t - => ArgumentConversion chn ('SchemaRef sch sty) t where - convertArg :: Proxy chn -> ArgumentValue' p ('SchemaRef sch sty) -> t -convertArg Proxy chn -_ (ArgSchema Term sch (sch :/: sty) -x) = Term sch (sch :/: sty) -> t +x +instance FromSchema sch sty t + => ArgumentConversion chn ('SchemaRef sch sty) t where + convertArg :: Proxy chn -> ArgumentValue' p ('SchemaRef sch sty) -> t +convertArg Proxy chn +_ (ArgSchema Term sch (sch :/: sty) +x) = Term sch (sch :/: sty) -> t forall typeName fieldName (sch :: Schema typeName fieldName) (sty :: typeName) t. FromSchema sch sty t => Term sch (sch :/: sty) -> t fromSchema Term sch (sch :/: sty) Term sch (sch :/: sty) -x -instance ArgumentConversion chn ref t - => ArgumentConversion chn ('ListRef ref) [t] where - convertArg :: Proxy chn -> ArgumentValue' p ('ListRef ref) -> [t] -convertArg Proxy chn -p (ArgList [ArgumentValue' p r] -x) = Proxy chn -> ArgumentValue' p r -> t +x +instance ArgumentConversion chn ref t + => ArgumentConversion chn ('ListRef ref) [t] where + convertArg :: Proxy chn -> ArgumentValue' p ('ListRef ref) -> [t] +convertArg Proxy chn +p (ArgList [ArgumentValue' p r] +x) = Proxy chn -> ArgumentValue' p r -> t forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm} {anm} (p :: Package snm mnm anm (TypeRef snm)). ArgumentConversion chn ref t => Proxy chn -> ArgumentValue' p ref -> t convertArg Proxy chn -p (ArgumentValue' p r -> t) -> [ArgumentValue' p r] -> [t] +p (ArgumentValue' p r -> t) -> [ArgumentValue' p r] -> [t] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ArgumentValue' p r] -x -instance ArgumentConversion chn ref t - => ArgumentConversion chn ('OptionalRef ref) (Maybe t) where - convertArg :: Proxy chn -> ArgumentValue' p ('OptionalRef ref) -> Maybe t -convertArg Proxy chn -p (ArgOptional Maybe (ArgumentValue' p r) -x) = Proxy chn -> ArgumentValue' p r -> t +x +instance ArgumentConversion chn ref t + => ArgumentConversion chn ('OptionalRef ref) (Maybe t) where + convertArg :: Proxy chn -> ArgumentValue' p ('OptionalRef ref) -> Maybe t +convertArg Proxy chn +p (ArgOptional Maybe (ArgumentValue' p r) +x) = Proxy chn -> ArgumentValue' p r -> t forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm} {anm} (p :: Package snm mnm anm (TypeRef snm)). ArgumentConversion chn ref t => Proxy chn -> ArgumentValue' p ref -> t convertArg Proxy chn -p (ArgumentValue' p r -> t) -> Maybe (ArgumentValue' p r) -> Maybe t +p (ArgumentValue' p r -> t) -> Maybe (ArgumentValue' p r) -> Maybe t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (ArgumentValue' p r) -x +x -class ToRef chn r l => ResultConversion m p whole chn r l where - convertResult :: (forall a. m a -> ServerErrorIO a) +class ToRef chn r l => ResultConversion m p whole chn r l where + convertResult :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders - -> ServerT chn GQL.Field p m whole + -> ServerT chn GQL.Field p m whole -> [T.Text] - -> ReturnQuery' p r - -> l -> WriterT [GraphQLError] IO (Maybe Aeson.Value) + -> ReturnQuery' p r + -> l -> WriterT [GraphQLError] IO (Maybe Aeson.Value) -instance Aeson.ToJSON t => ResultConversion m p whole chn ('PrimitiveRef t) t where - convertResult :: (forall a. m a -> ServerErrorIO a) +instance Aeson.ToJSON t => ResultConversion m p whole chn ('PrimitiveRef t) t where + convertResult :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] -> ReturnQuery' p ('PrimitiveRef t) -> t -> WriterT [GraphQLError] IO (Maybe Value) -convertResult forall a. m a -> ServerErrorIO a +convertResult forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole _ [Text] @@ -3412,23 +3412,23 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c . t -> Value forall a. ToJSON a => a -> Value Aeson.toJSON -instance ( ToSchema sch l r - , RunSchemaQuery sch (sch :/: l) ) - => ResultConversion m p whole chn ('SchemaRef sch l) r where - convertResult :: (forall a. m a -> ServerErrorIO a) +instance ( ToSchema sch l r + , RunSchemaQuery sch (sch :/: l) ) + => ResultConversion m p whole chn ('SchemaRef sch l) r where + convertResult :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] -> ReturnQuery' p ('SchemaRef sch l) -> r -> WriterT [GraphQLError] IO (Maybe Value) -convertResult forall a. m a -> ServerErrorIO a +convertResult forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole _ [Text] -_ (RetSchema SchemaQuery sch (sch :/: sty) -r) r -t +_ (RetSchema SchemaQuery sch (sch :/: sty) +r) r +t = Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -3446,29 +3446,29 @@ Term sch r -> SchemaQuery sch r -> Value forall fn tn (sch :: Schema tn fn) t (sty :: tn). ToSchema sch sty t => t -> Term sch (sch :/: sty) -toSchema' @_ @_ @sch @r r -t) SchemaQuery sch (sch :/: l) +toSchema' @_ @_ @sch @r r +t) SchemaQuery sch (sch :/: l) SchemaQuery sch (sch :/: sty) -r -instance ( MappingRight chn ref ~ t - , MappingRight chn (ServiceName svc) ~ t - , LookupService ss ref ~ svc - , RunQueryFindHandler m ('Package pname ss) whole chn ss svc whole) - => ResultConversion m ('Package pname ss) whole chn ('ObjectRef ref) t where - convertResult :: (forall a. m a -> ServerErrorIO a) +r +instance ( MappingRight chn ref ~ t + , MappingRight chn (ServiceName svc) ~ t + , LookupService ss ref ~ svc + , RunQueryFindHandler m ('Package pname ss) whole chn ss svc whole) + => ResultConversion m ('Package pname ss) whole chn ('ObjectRef ref) t where + convertResult :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field ('Package pname ss) m whole -> [Text] -> ReturnQuery' ('Package pname ss) ('ObjectRef ref) -> t -> WriterT [GraphQLError] IO (Maybe Value) -convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field ('Package pname ss) m whole -whole [Text] -path (RetObject ServiceQuery ('Package pname ss) (LookupService ss s) -q) t -h +convertResult forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field ('Package pname ss) m whole +whole [Text] +path (RetObject ServiceQuery ('Package pname ss) (LookupService ss s) +q) t +h = Value -> Maybe Value forall a. a -> Maybe a Just (Value -> Maybe Value) @@ -3498,29 +3498,29 @@ forall {snm} {mnm} {anm} (m :: * -> *) -> inh -> ServiceQuery p s -> WriterT [GraphQLError] IO Value -runQuery @m @('Package pname ss) @(LookupService ss ref) forall a. m a -> ServerErrorIO a -f RequestHeaders -req +runQuery @m @('Package pname ss) @(LookupService ss ref) forall a. m a -> ServerErrorIO a +f RequestHeaders +req (String -> Schema forall a. HasCallStack => String -> a error String "cannot inspect schema inside a field") ServerT chn Field ('Package pname ss) m whole -whole [Text] -path t -h ServiceQuery ('Package pname ss) (LookupService ss ref) +whole [Text] +path t +h ServiceQuery ('Package pname ss) (LookupService ss ref) ServiceQuery ('Package pname ss) (LookupService ss s) -q -instance ResultConversion m p whole chn r s - => ResultConversion m p whole chn ('OptionalRef r) (Maybe s) where - convertResult :: (forall a. m a -> ServerErrorIO a) +q +instance ResultConversion m p whole chn r s + => ResultConversion m p whole chn ('OptionalRef r) (Maybe s) where + convertResult :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] -> ReturnQuery' p ('OptionalRef r) -> Maybe s -> WriterT [GraphQLError] IO (Maybe Value) -convertResult forall a. m a -> ServerErrorIO a +convertResult forall a. m a -> ServerErrorIO a _ RequestHeaders _ ServerT chn Field p m whole _ [Text] @@ -3532,13 +3532,13 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (RetOptional ReturnQuery' p r -q) (Just s -x) + convertResult forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (RetOptional ReturnQuery' p r +q) (Just s +x) = (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole @@ -3558,28 +3558,28 @@ ResultConversion m p whole chn r l => -> l -> WriterT [GraphQLError] IO (Maybe Value) convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ReturnQuery' p r -q s -x -instance ResultConversion m p whole chn r s - => ResultConversion m p whole chn ('ListRef r) [s] where - convertResult :: (forall a. m a -> ServerErrorIO a) +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ReturnQuery' p r +q s +x +instance ResultConversion m p whole chn r s + => ResultConversion m p whole chn ('ListRef r) [s] where + convertResult :: (forall a. m a -> ServerErrorIO a) -> RequestHeaders -> ServerT chn Field p m whole -> [Text] -> ReturnQuery' p ('ListRef r) -> [s] -> WriterT [GraphQLError] IO (Maybe Value) -convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path (RetList ReturnQuery' p r -q) [s] -xs +convertResult forall a. m a -> ServerErrorIO a +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path (RetList ReturnQuery' p r +q) [s] +xs = Value -> Maybe Value forall a. a -> Maybe a Just (Value -> Maybe Value) @@ -3620,35 +3620,35 @@ ResultConversion m p whole chn r l => -> l -> WriterT [GraphQLError] IO (Maybe Value) convertResult forall a. m a -> ServerErrorIO a -f RequestHeaders -req ServerT chn Field p m whole -whole [Text] -path ReturnQuery' p r -q) [s] -xs +f RequestHeaders +req ServerT chn Field p m whole +whole [Text] +path ReturnQuery' p r +q) [s] +xs -class RunSchemaQuery sch r where +class RunSchemaQuery sch r where runSchemaQuery - :: Term sch r - -> SchemaQuery sch r + :: Term sch r + -> SchemaQuery sch r -> Aeson.Value -instance ( Aeson.ToJSON (Term sch ('DEnum name choices)) ) - => RunSchemaQuery sch ('DEnum name choices) where - runSchemaQuery :: Term sch ('DEnum name choices) +instance ( Aeson.ToJSON (Term sch ('DEnum name choices)) ) + => RunSchemaQuery sch ('DEnum name choices) where + runSchemaQuery :: Term sch ('DEnum name choices) -> SchemaQuery sch ('DEnum name choices) -> Value -runSchemaQuery Term sch ('DEnum name choices) -t SchemaQuery sch ('DEnum name choices) +runSchemaQuery Term sch ('DEnum name choices) +t SchemaQuery sch ('DEnum name choices) _ = Term sch ('DEnum name choices) -> Value forall a. ToJSON a => a -> Value Aeson.toJSON Term sch ('DEnum name choices) -t -instance ( KnownName rname, RunSchemaField sch fields ) - => RunSchemaQuery sch ('DRecord rname fields) where - runSchemaQuery :: Term sch ('DRecord rname fields) +t +instance ( KnownName rname, RunSchemaField sch fields ) + => RunSchemaQuery sch ('DRecord rname fields) where + runSchemaQuery :: Term sch ('DRecord rname fields) -> SchemaQuery sch ('DRecord rname fields) -> Value -runSchemaQuery (TRecord NP (Field sch) args -args) (QueryRecord [OneFieldQuery sch fs] -rs) +runSchemaQuery (TRecord NP (Field sch) args +args) (QueryRecord [OneFieldQuery sch fs] +rs) = [Pair] -> Value Aeson.object ([Pair] -> Value) -> [Pair] -> Value forall a b. (a -> b) -> a -> b @@ -3656,49 +3656,49 @@ forall a b. (a -> b) -> a -> b -> [OneFieldQuery sch args] -> [Pair] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe OneFieldQuery sch args -> Maybe Pair -runOneQuery [OneFieldQuery sch args] +runOneQuery [OneFieldQuery sch args] [OneFieldQuery sch fs] -rs +rs where - runOneQuery :: OneFieldQuery sch args -> Maybe Pair -runOneQuery (OneFieldQuery Maybe Text -nm NS (ChosenFieldQuery sch) args -choice) - = let (Maybe Value -val, Text -fname) = NP (Field sch) args + runOneQuery :: OneFieldQuery sch args -> Maybe Pair +runOneQuery (OneFieldQuery Maybe Text +nm NS (ChosenFieldQuery sch) args +choice) + = let (Maybe Value +val, Text +fname) = NP (Field sch) args -> NS (ChosenFieldQuery sch) args -> (Maybe Value, Text) forall {tn} {fn} (sch :: Schema tn fn) (args :: [FieldDef tn fn]). RunSchemaField sch args => NP (Field sch) args -> NS (ChosenFieldQuery sch) args -> (Maybe Value, Text) runSchemaField NP (Field sch) args -args NS (ChosenFieldQuery sch) args -choice - realName :: Text -realName = Text -> Maybe Text -> Text +args NS (ChosenFieldQuery sch) args +choice + realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text -fname Maybe Text -nm +fname Maybe Text +nm in (Text -realName,) (Value -> Pair) -> Maybe Value -> Maybe Pair +realName,) (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe Value -val - runOneQuery (TypeNameFieldQuery Maybe Text -nm) - = let realName :: Text -realName = Text -> Maybe Text -> Text +val + runOneQuery (TypeNameFieldQuery Maybe Text +nm) + = let realName :: Text +realName = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "__typename" Maybe Text -nm +nm -- add the 'R' because it's on return position in Pair -> Maybe Pair forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -realName, Text -> Value +realName, Text -> Value Aeson.String (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ String -> Text @@ -3710,45 +3710,45 @@ KnownName a => proxy a -> String nameVal (Proxy rname forall {k} (t :: k). Proxy t -Proxy @rname) String -> String -> String +Proxy @rname) String -> String -> String forall a. [a] -> [a] -> [a] ++ String "R") -class RunSchemaField sch args where +class RunSchemaField sch args where runSchemaField - :: NP (Field sch) args - -> NS (ChosenFieldQuery sch) args + :: NP (Field sch) args + -> NS (ChosenFieldQuery sch) args -> (Maybe Aeson.Value, T.Text) -instance RunSchemaField sch '[] where - runSchemaField :: NP (Field sch) '[] +instance RunSchemaField sch '[] where + runSchemaField :: NP (Field sch) '[] -> NS (ChosenFieldQuery sch) '[] -> (Maybe Value, Text) -runSchemaField = String +runSchemaField = String -> NP (Field sch) '[] -> NS (ChosenFieldQuery sch) '[] -> (Maybe Value, Text) forall a. HasCallStack => String -> a error String "this should never be called" -instance (KnownName fname, RunSchemaType sch t, RunSchemaField sch fs) - => RunSchemaField sch ('FieldDef fname t ': fs) where - runSchemaField :: NP (Field sch) ('FieldDef fname t : fs) +instance (KnownName fname, RunSchemaType sch t, RunSchemaField sch fs) + => RunSchemaField sch ('FieldDef fname t ': fs) where + runSchemaField :: NP (Field sch) ('FieldDef fname t : fs) -> NS (ChosenFieldQuery sch) ('FieldDef fname t : fs) -> (Maybe Value, Text) -runSchemaField (Field FieldValue sch t -x :* NP (Field sch) xs -_) (Z (ChosenFieldQuery ReturnSchemaQuery sch r -c)) +runSchemaField (Field FieldValue sch t +x :* NP (Field sch) xs +_) (Z (ChosenFieldQuery ReturnSchemaQuery sch r +c)) = (FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value forall {tn} {fn} (sch :: Schema tn fn) (t :: FieldType tn). RunSchemaType sch t => FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value runSchemaType FieldValue sch t -x ReturnSchemaQuery sch t +x ReturnSchemaQuery sch t ReturnSchemaQuery sch r -c, String -> Text +c, String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Proxy fname -> String @@ -3757,11 +3757,11 @@ KnownName a => proxy a -> String nameVal (Proxy fname forall {k} (t :: k). Proxy t -Proxy @fname)) +Proxy @fname)) runSchemaField (Field sch x -_ :* NP (Field sch) xs -xs) (S NS (ChosenFieldQuery sch) xs -rest) +_ :* NP (Field sch) xs +xs) (S NS (ChosenFieldQuery sch) xs +rest) = NP (Field sch) xs -> NS (ChosenFieldQuery sch) xs -> (Maybe Value, Text) forall {tn} {fn} (sch :: Schema tn fn) (args :: [FieldDef tn fn]). @@ -3769,21 +3769,21 @@ RunSchemaField sch args => NP (Field sch) args -> NS (ChosenFieldQuery sch) args -> (Maybe Value, Text) runSchemaField NP (Field sch) xs -xs NS (ChosenFieldQuery sch) xs +xs NS (ChosenFieldQuery sch) xs NS (ChosenFieldQuery sch) xs -rest +rest -class RunSchemaType sch t where +class RunSchemaType sch t where runSchemaType - :: FieldValue sch t - -> ReturnSchemaQuery sch t + :: FieldValue sch t + -> ReturnSchemaQuery sch t -> Maybe Aeson.Value -instance ( Aeson.ToJSON t ) - => RunSchemaType sch ('TPrimitive t) where - runSchemaType :: FieldValue sch ('TPrimitive t) +instance ( Aeson.ToJSON t ) + => RunSchemaType sch ('TPrimitive t) where + runSchemaType :: FieldValue sch ('TPrimitive t) -> ReturnSchemaQuery sch ('TPrimitive t) -> Maybe Value -runSchemaType (FPrimitive t1 -x) ReturnSchemaQuery sch ('TPrimitive t) +runSchemaType (FPrimitive t1 +x) ReturnSchemaQuery sch ('TPrimitive t) _ = Value -> Maybe Value forall a. a -> Maybe a @@ -3792,14 +3792,14 @@ forall a b. (a -> b) -> a -> b $ t1 -> Value forall a. ToJSON a => a -> Value Aeson.toJSON t1 -x -instance RunSchemaType sch r - => RunSchemaType sch ('TList r) where - runSchemaType :: FieldValue sch ('TList r) +x +instance RunSchemaType sch r + => RunSchemaType sch ('TList r) where + runSchemaType :: FieldValue sch ('TList r) -> ReturnSchemaQuery sch ('TList r) -> Maybe Value -runSchemaType (FList [FieldValue sch t1] -xs) (RetSchList ReturnSchemaQuery sch r -r) +runSchemaType (FList [FieldValue sch t1] +xs) (RetSchList ReturnSchemaQuery sch r +r) = Value -> Maybe Value forall a. a -> Maybe a Just (Value -> Maybe Value) @@ -3816,18 +3816,18 @@ forall {tn} {fn} (sch :: Schema tn fn) (t :: FieldType tn). RunSchemaType sch t => FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value `runSchemaType` ReturnSchemaQuery sch r -r) [FieldValue sch t1] +r) [FieldValue sch t1] [FieldValue sch r] -xs -instance RunSchemaType sch r - => RunSchemaType sch ('TOption r) where - runSchemaType :: FieldValue sch ('TOption r) +xs +instance RunSchemaType sch r + => RunSchemaType sch ('TOption r) where + runSchemaType :: FieldValue sch ('TOption r) -> ReturnSchemaQuery sch ('TOption r) -> Maybe Value -runSchemaType (FOption Maybe (FieldValue sch t1) -xs) (RetSchOptional ReturnSchemaQuery sch r -r) +runSchemaType (FOption Maybe (FieldValue sch t1) +xs) (RetSchOptional ReturnSchemaQuery sch r +r) = Maybe (FieldValue sch t1) -xs Maybe (FieldValue sch t1) +xs Maybe (FieldValue sch t1) -> (FieldValue sch t1 -> Maybe Value) -> Maybe Value forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (FieldValue sch r -> ReturnSchemaQuery sch r -> Maybe Value) @@ -3838,14 +3838,14 @@ forall {tn} {fn} (sch :: Schema tn fn) (t :: FieldType tn). RunSchemaType sch t => FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value runSchemaType ReturnSchemaQuery sch r -r -instance RunSchemaQuery sch (sch :/: l) - => RunSchemaType sch ('TSchematic l) where - runSchemaType :: FieldValue sch ('TSchematic l) +r +instance RunSchemaQuery sch (sch :/: l) + => RunSchemaType sch ('TSchematic l) where + runSchemaType :: FieldValue sch ('TSchematic l) -> ReturnSchemaQuery sch ('TSchematic l) -> Maybe Value -runSchemaType (FSchematic Term sch (sch :/: t1) -t) (RetSchSchema SchemaQuery sch (sch :/: sty) -r) +runSchemaType (FSchematic Term sch (sch :/: t1) +t) (RetSchSchema SchemaQuery sch (sch :/: sty) +r) = Value -> Maybe Value forall a. a -> Maybe a Just (Value -> Maybe Value) -> Value -> Maybe Value @@ -3856,25 +3856,25 @@ RunSchemaQuery sch r => Term sch r -> SchemaQuery sch r -> Value runSchemaQuery Term sch (sch :/: l) Term sch (sch :/: t1) -t SchemaQuery sch (sch :/: l) +t SchemaQuery sch (sch :/: l) SchemaQuery sch (sch :/: sty) -r +r runIntroSchema :: [T.Text] -> Intro.Schema -> [GQL.Selection] -> WriterT [GraphQLError] IO Aeson.Value runIntroSchema :: [Text] -> Schema -> [Selection] -> WriterT [GraphQLError] IO Value -runIntroSchema [Text] -path s :: Schema -s@(Intro.Schema Maybe Text -qr Maybe Text -mut Maybe Text -sub TypeMap -ts) [Selection] -ss - = do [Pair] -things <- [Maybe Pair] -> [Pair] +runIntroSchema [Text] +path s :: Schema +s@(Intro.Schema Maybe Text +qr Maybe Text +mut Maybe Text +sub TypeMap +ts) [Selection] +ss + = do [Pair] +things <- [Maybe Pair] -> [Pair] forall a. [Maybe a] -> [a] catMaybes ([Maybe Pair] -> [Pair]) -> WriterT [GraphQLError] IO [Maybe Pair] @@ -3886,8 +3886,8 @@ forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runOne [Selection] -ss +runOne [Selection] +ss Value -> WriterT [GraphQLError] IO Value forall (f :: * -> *) a. Applicative f => a -> f a pure (Value -> WriterT [GraphQLError] IO Value) @@ -3895,38 +3895,38 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [Pair] -things +things where - runOne :: Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runOne (GQL.FieldSelection (GQL.Field Maybe Text -alias Text -nm [Argument] + runOne :: Selection -> WriterT [GraphQLError] IO (Maybe Pair) +runOne (GQL.FieldSelection (GQL.Field Maybe Text +alias Text +nm [Argument] _ [Directive] -_ [Selection] -innerss Location +_ [Selection] +innerss Location _)) - = let Text -realName :: T.Text = Text -> Maybe Text -> Text + = let Text +realName :: T.Text = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text -nm Maybe Text -alias - path' :: [Text] -path' = [Text] -path [Text] -> [Text] -> [Text] +nm Maybe Text +alias + path' :: [Text] +path' = [Text] +path [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] Text -realName] +realName] in (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -realName,) (Maybe Value -> Maybe Pair) +realName,) (Maybe Value -> Maybe Pair) -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> case Text -nm of +nm of Text "description" -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -3954,91 +3954,91 @@ forall a b. (a -> b) -> a -> b Text "queryType" -> case Maybe Text -qr Maybe Text -> (Text -> Maybe Type) -> Maybe Type +qr Maybe Text -> (Text -> Maybe Type) -> Maybe Type forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type forall a b c. (a -> b -> c) -> b -> a -> c flip Text -> TypeMap -> Maybe Type forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup TypeMap -ts of +ts of Maybe Type Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - Just Type -ty -> [Text] --> Schema --> Type --> [Selection] --> WriterT [GraphQLError] IO (Maybe Value) -runIntroType [Text] -path' Schema -s Type -ty [Selection] -innerss - Text -"mutationType" - -> case Maybe Text -mut Maybe Text -> (Text -> Maybe Type) -> Maybe Type -forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b ->>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type -forall a b c. (a -> b -> c) -> b -> a -> c -flip Text -> TypeMap -> Maybe Type -forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v -HM.lookup TypeMap -ts of - Maybe Type -Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) -forall (f :: * -> *) a. Applicative f => a -> f a -pure Maybe Value -forall a. Maybe a -Nothing - Just Type + Just Type ty -> [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path' Schema -s Type +path' Schema +s Type ty [Selection] -innerss - Text -"subscriptionType" - -> case Maybe Text -sub Maybe Text -> (Text -> Maybe Type) -> Maybe Type +innerss + Text +"mutationType" + -> case Maybe Text +mut Maybe Text -> (Text -> Maybe Type) -> Maybe Type forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type forall a b c. (a -> b -> c) -> b -> a -> c flip Text -> TypeMap -> Maybe Type forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup TypeMap -ts of - Maybe Type +ts of + Maybe Type Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - Just Type + Just Type ty -> [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path' Schema -s Type +path' Schema +s Type ty [Selection] -innerss +innerss + Text +"subscriptionType" + -> case Maybe Text +sub Maybe Text -> (Text -> Maybe Type) -> Maybe Type +forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b +>>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type +forall a b c. (a -> b -> c) -> b -> a -> c +flip Text -> TypeMap -> Maybe Type +forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v +HM.lookup TypeMap +ts of + Maybe Type +Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) +forall (f :: * -> *) a. Applicative f => a -> f a +pure Maybe Value +forall a. Maybe a +Nothing + Just Type +ty -> [Text] +-> Schema +-> Type +-> [Selection] +-> WriterT [GraphQLError] IO (Maybe Value) +runIntroType [Text] +path' Schema +s Type +ty [Selection] +innerss Text "types" - -> do [Value] -tys <- [Maybe Value] -> [Value] + -> do [Value] +tys <- [Maybe Value] -> [Value] forall a. [Maybe a] -> [a] catMaybes ([Maybe Value] -> [Value]) -> WriterT [GraphQLError] IO [Maybe Value] @@ -4049,20 +4049,20 @@ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) -mapM (\Type -t -> [Text] +mapM (\Type +t -> [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path' Schema -s Type -t [Selection] -innerss) (TypeMap -> [Type] +path' Schema +s Type +t [Selection] +innerss) (TypeMap -> [Type] forall k v. HashMap k v -> [v] HM.elems TypeMap -ts) +ts) Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4075,7 +4075,7 @@ forall a b. (a -> b) -> a -> b $ [Value] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Value] -tys +tys Text _ -> do [GraphQLError] -> WriterT [GraphQLError] IO () forall w (m :: * -> *). MonadWriter w m => w -> m () @@ -4091,19 +4091,19 @@ forall a b. (a -> b) -> a -> b forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text -nm String -> String -> String +nm String -> String -> String forall a. Semigroup a => a -> a -> a <> String "' was not found on type '__Schema'") [Text] -path] +path] Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing -- we do not support spreads here - runOne Selection + runOne Selection _ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Pair @@ -4118,49 +4118,49 @@ forall a. Maybe a -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroType [Text] -path s :: Schema -s@(Intro.Schema Maybe Text +runIntroType [Text] +path s :: Schema +s@(Intro.Schema Maybe Text _ Maybe Text _ Maybe Text -_ TypeMap -ts) (Intro.TypeRef Text -t) [Selection] -ss +_ TypeMap +ts) (Intro.TypeRef Text +t) [Selection] +ss = case Text -> TypeMap -> Maybe Type forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup Text -t TypeMap -ts of +t TypeMap +ts of Maybe Type Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing - Just Type -ty -> [Text] + Just Type +ty -> [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path Schema -s Type -ty [Selection] -ss -runIntroType [Text] -path Schema -s (Intro.Type TypeKind -k Maybe Text -tnm [Field] -fs [EnumValue] -vals [Type] -posTys Maybe Type -ofT) [Selection] -ss - = do [Pair] -things <- [Maybe Pair] -> [Pair] +path Schema +s Type +ty [Selection] +ss +runIntroType [Text] +path Schema +s (Intro.Type TypeKind +k Maybe Text +tnm [Field] +fs [EnumValue] +vals [Type] +posTys Maybe Type +ofT) [Selection] +ss + = do [Pair] +things <- [Maybe Pair] -> [Pair] forall a. [Maybe a] -> [a] catMaybes ([Maybe Pair] -> [Pair]) -> WriterT [GraphQLError] IO [Maybe Pair] @@ -4172,8 +4172,8 @@ forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runOne [Selection] -ss +runOne [Selection] +ss Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4185,39 +4185,39 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [Pair] -things +things where - runOne :: Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runOne (GQL.FieldSelection (GQL.Field Maybe Text -alias Text -nm [Argument] + runOne :: Selection -> WriterT [GraphQLError] IO (Maybe Pair) +runOne (GQL.FieldSelection (GQL.Field Maybe Text +alias Text +nm [Argument] _ [Directive] -_ [Selection] -innerss Location +_ [Selection] +innerss Location _)) - = let Text -realName :: T.Text = Text -> Maybe Text -> Text + = let Text +realName :: T.Text = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text -nm Maybe Text -alias - path' :: [Text] -path' = [Text] -path [Text] -> [Text] -> [Text] +nm Maybe Text +alias + path' :: [Text] +path' = [Text] +path [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] Text -realName] +realName] in (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -realName,) (Maybe Value -> Maybe Pair) +realName,) (Maybe Value -> Maybe Pair) -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> case (Text -nm, [Selection] -innerss) of +nm, [Selection] +innerss) of (Text "kind", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -4236,7 +4236,7 @@ forall a b. (a -> b) -> a -> b T.pack (TypeKind -> String forall a. Show a => a -> String show TypeKind -k) +k) (Text "name", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -4253,7 +4253,7 @@ forall b a. b -> (a -> b) -> Maybe a -> b maybe Value Aeson.Null Text -> Value Aeson.String Maybe Text -tnm +tnm (Text "description", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -4270,23 +4270,23 @@ forall a. a -> Maybe a "fields", [Selection] _) -> case TypeKind -k of +k of TypeKind Intro.OBJECT - -> do [Maybe Value] -things <- (Field -> WriterT [GraphQLError] IO (Maybe Value)) + -> do [Maybe Value] +things <- (Field -> WriterT [GraphQLError] IO (Maybe Value)) -> [Field] -> WriterT [GraphQLError] IO [Maybe Value] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) -mapM (\Field -f -> [Text] +mapM (\Field +f -> [Text] -> Field -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroFields [Text] -path' Field -f [Selection] -innerss) [Field] -fs +runIntroFields [Text] +path' Field +f [Selection] +innerss) [Field] +fs Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4299,7 +4299,7 @@ forall a b. (a -> b) -> a -> b $ [Maybe Value] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Maybe Value] -things +things TypeKind _ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a @@ -4314,23 +4314,23 @@ forall a. a -> Maybe a "inputFields", [Selection] _) -> case TypeKind -k of +k of TypeKind Intro.INPUT_OBJECT - -> do [Maybe Value] -things <- (Field -> WriterT [GraphQLError] IO (Maybe Value)) + -> do [Maybe Value] +things <- (Field -> WriterT [GraphQLError] IO (Maybe Value)) -> [Field] -> WriterT [GraphQLError] IO [Maybe Value] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) -mapM (\Field -f -> [Text] +mapM (\Field +f -> [Text] -> Field -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroFields [Text] -path' Field -f [Selection] -innerss) [Field] -fs +runIntroFields [Text] +path' Field +f [Selection] +innerss) [Field] +fs Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4343,7 +4343,7 @@ forall a b. (a -> b) -> a -> b $ [Maybe Value] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Maybe Value] -things +things TypeKind _ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a @@ -4357,22 +4357,22 @@ forall a. a -> Maybe a (Text "enumValues", [Selection] _) - -> do [Maybe Value] -things <- (EnumValue -> WriterT [GraphQLError] IO (Maybe Value)) + -> do [Maybe Value] +things <- (EnumValue -> WriterT [GraphQLError] IO (Maybe Value)) -> [EnumValue] -> WriterT [GraphQLError] IO [Maybe Value] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) -mapM (\EnumValue -e -> [Text] +mapM (\EnumValue +e -> [Text] -> EnumValue -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroEnums [Text] -path' EnumValue -e [Selection] -innerss) [EnumValue] -vals +runIntroEnums [Text] +path' EnumValue +e [Selection] +innerss) [EnumValue] +vals Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4385,13 +4385,13 @@ forall a b. (a -> b) -> a -> b $ [Maybe Value] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Maybe Value] -things +things (Text "ofType", [Selection] _) -> case Maybe Type -ofT of +ofT of Maybe Type Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a @@ -4402,17 +4402,17 @@ forall a b. (a -> b) -> a -> b forall a. a -> Maybe a Just Value Aeson.Null - Just Type -o -> [Text] + Just Type +o -> [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path' Schema -s Type -o [Selection] -innerss +path' Schema +s Type +o [Selection] +innerss -- unions and interfaces are not supported (Text @@ -4433,11 +4433,11 @@ forall a b. (a -> b) -> a -> b "possibleTypes", [Selection] _) -> case TypeKind -k of +k of TypeKind Intro.UNION - -> do [Value] -res <- [Maybe Value] -> [Value] + -> do [Value] +res <- [Maybe Value] -> [Value] forall a. [Maybe a] -> [a] catMaybes ([Maybe Value] -> [Value]) -> WriterT [GraphQLError] IO [Maybe Value] @@ -4449,18 +4449,18 @@ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) -mapM (\Type -o -> [Text] +mapM (\Type +o -> [Text] -> Schema -> Type -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -path' Schema -s Type -o [Selection] -innerss) [Type] -posTys +path' Schema +s Type +o [Selection] +innerss) [Type] +posTys Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4473,7 +4473,7 @@ forall a b. (a -> b) -> a -> b $ [Value] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Value] -res +res TypeKind _ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a @@ -4500,36 +4500,36 @@ forall a b. (a -> b) -> a -> b forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text -nm String -> String -> String +nm String -> String -> String forall a. Semigroup a => a -> a -> a <> String "' was not found on type '__Type'") [Text] -path] +path] Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing -- we do not support spreads here - runOne Selection + runOne Selection _ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Pair forall a. Maybe a Nothing - runIntroFields + runIntroFields :: [T.Text] -> Intro.Field -> [GQL.Selection] -> WriterT [GraphQLError] IO (Maybe Aeson.Value) - runIntroFields :: [Text] + runIntroFields :: [Text] -> Field -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroFields [Text] -fpath Field -fld [Selection] -fss - = do [Pair] -things <- [Maybe Pair] -> [Pair] +runIntroFields [Text] +fpath Field +fld [Selection] +fss + = do [Pair] +things <- [Maybe Pair] -> [Pair] forall a. [Maybe a] -> [a] catMaybes ([Maybe Pair] -> [Pair]) -> WriterT [GraphQLError] IO [Maybe Pair] @@ -4542,10 +4542,10 @@ forall (t :: * -> *) (f :: * -> *) a b. (a -> f b) -> t a -> f (t b) traverse ([Text] -> Field -> Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runIntroField [Text] -fpath Field -fld) [Selection] -fss +runIntroField [Text] +fpath Field +fld) [Selection] +fss Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4557,45 +4557,45 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [Pair] -things +things - runIntroField :: [Text] + runIntroField :: [Text] -> Field -> Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runIntroField [Text] -fpath (Intro.Field Text -fnm [Input] -fargs Type -fty) - (GQL.FieldSelection (GQL.Field Maybe Text -alias Text -nm [Argument] +runIntroField [Text] +fpath (Intro.Field Text +fnm [Input] +fargs Type +fty) + (GQL.FieldSelection (GQL.Field Maybe Text +alias Text +nm [Argument] _ [Directive] -_ [Selection] -innerss Location +_ [Selection] +innerss Location _)) - = let Text -realName :: T.Text = Text -> Maybe Text -> Text + = let Text +realName :: T.Text = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text -nm Maybe Text -alias - fpath' :: [Text] -fpath' = [Text] -fpath [Text] -> [Text] -> [Text] +nm Maybe Text +alias + fpath' :: [Text] +fpath' = [Text] +fpath [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] Text -realName] +realName] in (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -realName,) (Maybe Value -> Maybe Pair) +realName,) (Maybe Value -> Maybe Pair) -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> case (Text -nm, [Selection] -innerss) of +nm, [Selection] +innerss) of (Text "name", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -4609,7 +4609,7 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ Text -> Value Aeson.String Text -fnm +fnm (Text "description", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -4671,27 +4671,27 @@ forall a. a -> Maybe a -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -fpath' Schema -s Type -fty [Selection] -innerss +fpath' Schema +s Type +fty [Selection] +innerss (Text "args", [Selection] _) - -> do [Maybe Value] -things <- (Input -> WriterT [GraphQLError] IO (Maybe Value)) + -> do [Maybe Value] +things <- (Input -> WriterT [GraphQLError] IO (Maybe Value)) -> [Input] -> WriterT [GraphQLError] IO [Maybe Value] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) -mapM (\Input -i -> [Text] +mapM (\Input +i -> [Text] -> Input -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroInputs [Text] -fpath' Input -i [Selection] -innerss) [Input] -fargs +runIntroInputs [Text] +fpath' Input +i [Selection] +innerss) [Input] +fargs Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4704,7 +4704,7 @@ forall a b. (a -> b) -> a -> b $ [Maybe Value] -> Value forall a. ToJSON a => a -> Value Aeson.toJSON [Maybe Value] -things +things (Text, [Selection]) _ -> do [GraphQLError] -> WriterT [GraphQLError] IO () @@ -4721,19 +4721,19 @@ forall a b. (a -> b) -> a -> b forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text -nm String -> String -> String +nm String -> String -> String forall a. Semigroup a => a -> a -> a <> String "' was not found on type '__Field'") [Text] -fpath] +fpath] Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing -- we do not support spreads here - runIntroField [Text] + runIntroField [Text] _ Field _ Selection _ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) @@ -4742,19 +4742,19 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a. Maybe a Nothing - runIntroEnums + runIntroEnums :: [T.Text] -> Intro.EnumValue -> [GQL.Selection] -> WriterT [GraphQLError] IO (Maybe Aeson.Value) - runIntroEnums :: [Text] + runIntroEnums :: [Text] -> EnumValue -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroEnums [Text] -epath EnumValue -enm [Selection] -ess - = do [Pair] -things <- [Maybe Pair] -> [Pair] +runIntroEnums [Text] +epath EnumValue +enm [Selection] +ess + = do [Pair] +things <- [Maybe Pair] -> [Pair] forall a. [Maybe a] -> [a] catMaybes ([Maybe Pair] -> [Pair]) -> WriterT [GraphQLError] IO [Maybe Pair] @@ -4770,10 +4770,10 @@ forall (t :: * -> *) (f :: * -> *) a b. forall {f :: * -> *} {w}. (MonadWriter w f, IsList w, Item w ~ GraphQLError) => [Text] -> EnumValue -> Selection -> f (Maybe Pair) -runIntroEnum [Text] -epath EnumValue -enm) [Selection] -ess +runIntroEnum [Text] +epath EnumValue +enm) [Selection] +ess Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4785,33 +4785,33 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [Pair] -things +things - runIntroEnum :: [Text] -> EnumValue -> Selection -> f (Maybe Pair) -runIntroEnum [Text] -epath (Intro.EnumValue Text -enm) - (GQL.FieldSelection (GQL.Field Maybe Text -alias Text -nm [Argument] + runIntroEnum :: [Text] -> EnumValue -> Selection -> f (Maybe Pair) +runIntroEnum [Text] +epath (Intro.EnumValue Text +enm) + (GQL.FieldSelection (GQL.Field Maybe Text +alias Text +nm [Argument] _ [Directive] -_ [Selection] -innerss Location +_ [Selection] +innerss Location _)) - = let Text -realName :: T.Text = Text -> Maybe Text -> Text + = let Text +realName :: T.Text = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text -nm Maybe Text -alias +nm Maybe Text +alias in (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -realName,) (Maybe Value -> Maybe Pair) -> f (Maybe Value) -> f (Maybe Pair) +realName,) (Maybe Value -> Maybe Pair) -> f (Maybe Value) -> f (Maybe Pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> case (Text -nm, [Selection] -innerss) of +nm, [Selection] +innerss) of (Text "name", []) -> Maybe Value -> f (Maybe Value) @@ -4824,7 +4824,7 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ Text -> Value Aeson.String Text -enm +enm (Text "description", []) -> Maybe Value -> f (Maybe Value) @@ -4874,19 +4874,19 @@ forall a b. (a -> b) -> a -> b forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text -nm String -> String -> String +nm String -> String -> String forall a. Semigroup a => a -> a -> a <> String "' was not found on type '__EnumValue'") [Text] -epath] +epath] Maybe Value -> f (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing -- we do not support spreads here - runIntroEnum [Text] + runIntroEnum [Text] _ EnumValue _ Selection _ = Maybe Pair -> f (Maybe Pair) @@ -4895,17 +4895,17 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a. Maybe a Nothing - runIntroInputs + runIntroInputs :: [T.Text] -> Intro.Input -> [GQL.Selection] -> WriterT [GraphQLError] IO (Maybe Aeson.Value) - runIntroInputs :: [Text] + runIntroInputs :: [Text] -> Input -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) -runIntroInputs [Text] -ipath Input -inm [Selection] -iss - = do [Pair] -things <- [Maybe Pair] -> [Pair] +runIntroInputs [Text] +ipath Input +inm [Selection] +iss + = do [Pair] +things <- [Maybe Pair] -> [Pair] forall a. [Maybe a] -> [a] catMaybes ([Maybe Pair] -> [Pair]) -> WriterT [GraphQLError] IO [Maybe Pair] @@ -4918,10 +4918,10 @@ forall (t :: * -> *) (f :: * -> *) a b. (a -> f b) -> t a -> f (t b) traverse ([Text] -> Input -> Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runIntroInput [Text] -ipath Input -inm) [Selection] -iss +runIntroInput [Text] +ipath Input +inm) [Selection] +iss Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)) @@ -4933,45 +4933,45 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ [Pair] -> Value Aeson.object [Pair] -things +things - runIntroInput :: [Text] + runIntroInput :: [Text] -> Input -> Selection -> WriterT [GraphQLError] IO (Maybe Pair) -runIntroInput [Text] -ipath (Intro.Input Text -inm Maybe Text -def Type -ty) - (GQL.FieldSelection (GQL.Field Maybe Text -alias Text -nm [Argument] +runIntroInput [Text] +ipath (Intro.Input Text +inm Maybe Text +def Type +ty) + (GQL.FieldSelection (GQL.Field Maybe Text +alias Text +nm [Argument] _ [Directive] -_ [Selection] -innerss Location +_ [Selection] +innerss Location _)) - = let Text -realName :: T.Text = Text -> Maybe Text -> Text + = let Text +realName :: T.Text = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text -nm Maybe Text -alias - ipath' :: [Text] -ipath' = [Text] -ipath [Text] -> [Text] -> [Text] +nm Maybe Text +alias + ipath' :: [Text] +ipath' = [Text] +ipath [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] Text -realName] +realName] in (Value -> Pair) -> Maybe Value -> Maybe Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -realName,) (Maybe Value -> Maybe Pair) +realName,) (Maybe Value -> Maybe Pair) -> WriterT [GraphQLError] IO (Maybe Value) -> WriterT [GraphQLError] IO (Maybe Pair) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> case (Text -nm, [Selection] -innerss) of +nm, [Selection] +innerss) of (Text "name", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -4985,7 +4985,7 @@ forall a. a -> Maybe a forall a b. (a -> b) -> a -> b $ Text -> Value Aeson.String Text -inm +inm (Text "description", []) -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) @@ -5013,7 +5013,7 @@ forall b a. b -> (a -> b) -> Maybe a -> b maybe Value Aeson.Null Text -> Value Aeson.String Maybe Text -def +def (Text "type", [Selection] @@ -5024,10 +5024,10 @@ forall b a. b -> (a -> b) -> Maybe a -> b -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value) runIntroType [Text] -ipath' Schema -s Type -ty [Selection] -innerss +ipath' Schema +s Type +ty [Selection] +innerss (Text, [Selection]) _ -> do [GraphQLError] -> WriterT [GraphQLError] IO () @@ -5044,19 +5044,19 @@ forall a b. (a -> b) -> a -> b forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text -nm String -> String -> String +nm String -> String -> String forall a. Semigroup a => a -> a -> a <> String "' was not found on type '__Field'") [Text] -ipath] +ipath] Maybe Value -> WriterT [GraphQLError] IO (Maybe Value) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Value forall a. Maybe a Nothing -- we do not support spreads here - runIntroInput [Text] + runIntroInput [Text] _ Input _ Selection _ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair) diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Server.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Server.html index 1da4ee9..3961670 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Server.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Server.html @@ -65,8 +65,8 @@ more control over the settings. data GraphQLInput = GraphQLInput T.Text VariableMapC (Maybe T.Text) -instance A.FromJSON GraphQLInput where - parseJSON :: Value -> Parser GraphQLInput +instance A.FromJSON GraphQLInput where + parseJSON :: Value -> Parser GraphQLInput parseJSON = String -> (Object -> Parser GraphQLInput) -> Value -> Parser GraphQLInput forall a. String -> (Object -> Parser a) -> Value -> Parser a @@ -75,15 +75,15 @@ forall a. String -> (Object -> Parser a) -> Value -> Parser a -> (Object -> Parser GraphQLInput) -> Value -> Parser GraphQLInput forall a b. (a -> b) -> a -> b $ - \Object -v -> Text -> VariableMapC -> Maybe Text -> GraphQLInput + \Object +v -> Text -> VariableMapC -> Maybe Text -> GraphQLInput GraphQLInput (Text -> VariableMapC -> Maybe Text -> GraphQLInput) -> Parser Text -> Parser (VariableMapC -> Maybe Text -> GraphQLInput) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object -v Object -> Text -> Parser Text +v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a A..: Text "query" @@ -91,7 +91,7 @@ forall a. FromJSON a => Object -> Text -> Parser a -> Parser VariableMapC -> Parser (Maybe Text -> GraphQLInput) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Object -v Object -> Text -> Parser VariableMapC +v Object -> Text -> Parser VariableMapC forall a. FromJSON a => Object -> Text -> Parser a A..: Text "variables" Parser VariableMapC -> Parser VariableMapC -> Parser VariableMapC @@ -105,7 +105,7 @@ forall k v. HashMap k v -> Parser (Maybe Text) -> Parser GraphQLInput forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object -v Object -> Text -> Parser (Maybe Text) +v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) A..:? Text "operationName" @@ -113,12 +113,12 @@ forall a. FromJSON a => Object -> Text -> Parser (Maybe a) -- | Turn a Mu GraphQL 'Server' into a WAI 'Application'. -- Use this version when your server has not only -- queries, but also mutations or subscriptions. -graphQLApp :: - ( GraphQLApp p qr mut sub ServerErrorIO chn hs ) - => ServerT chn GQL.Field p ServerErrorIO hs - -> Proxy qr - -> Proxy mut - -> Proxy sub +graphQLApp :: + ( GraphQLApp p qr mut sub ServerErrorIO chn hs ) + => ServerT chn GQL.Field p ServerErrorIO hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> Application graphQLApp :: ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Proxy mut -> Proxy sub -> Application @@ -145,14 +145,14 @@ forall a. ServerErrorIO a -> ServerErrorIO a -- | Turn a Mu GraphQL 'Server' into a WAI 'Application'. -- Use this version when your server has only queries. graphQLAppQuery :: - forall qr p chn hs. - ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs ) - => ServerT chn GQL.Field p ServerErrorIO hs - -> Proxy qr + forall qr p chn hs. + ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs ) + => ServerT chn GQL.Field p ServerErrorIO hs + -> Proxy qr -> Application graphQLAppQuery :: ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application -graphQLAppQuery ServerT chn Field p ServerErrorIO hs -svr Proxy qr +graphQLAppQuery ServerT chn Field p ServerErrorIO hs +svr Proxy qr _ = ServerT chn Field p ServerErrorIO hs -> Proxy ('Just qr) @@ -165,9 +165,9 @@ GraphQLApp p qr mut sub ServerErrorIO chn hs => ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Proxy mut -> Proxy sub -> Application graphQLApp ServerT chn Field p ServerErrorIO hs -svr (Proxy ('Just qr) +svr (Proxy ('Just qr) forall k (t :: k). Proxy t -Proxy @('Just qr)) (Proxy 'Nothing +Proxy @('Just qr)) (Proxy 'Nothing forall k (t :: k). Proxy t Proxy @'Nothing) (Proxy 'Nothing forall k (t :: k). Proxy t @@ -177,17 +177,17 @@ forall k (t :: k). Proxy t -- using a combined transformer stack. -- See also documentation for 'graphQLAppQuery'. graphQLAppTransQuery :: - forall qr m p chn hs. - ( GraphQLApp p ('Just qr) 'Nothing 'Nothing m chn hs ) - => (forall a. m a -> ServerErrorIO a) - -> ServerT chn GQL.Field p m hs - -> Proxy qr + forall qr m p chn hs. + ( GraphQLApp p ('Just qr) 'Nothing 'Nothing m chn hs ) + => (forall a. m a -> ServerErrorIO a) + -> ServerT chn GQL.Field p m hs + -> Proxy qr -> Application graphQLAppTransQuery :: (forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs -> Proxy qr -> Application -graphQLAppTransQuery forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -svr Proxy qr +graphQLAppTransQuery forall a. m a -> ServerErrorIO a +f ServerT chn Field p m hs +svr Proxy qr _ = (forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs @@ -206,10 +206,10 @@ GraphQLApp p qr mut sub m chn hs => -> Proxy sub -> Application graphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -svr (Proxy ('Just qr) +f ServerT chn Field p m hs +svr (Proxy ('Just qr) forall k (t :: k). Proxy t -Proxy @('Just qr)) (Proxy 'Nothing +Proxy @('Just qr)) (Proxy 'Nothing forall k (t :: k). Proxy t Proxy @'Nothing) (Proxy 'Nothing forall k (t :: k). Proxy t @@ -218,13 +218,13 @@ forall k (t :: k). Proxy t -- | Turn a Mu GraphQL 'Server' into a WAI 'Application' -- using a combined transformer stack. -- See also documentation for 'graphQLApp'. -graphQLAppTrans :: - ( GraphQLApp p qr mut sub m chn hs ) - => (forall a. m a -> ServerErrorIO a) - -> ServerT chn GQL.Field p m hs - -> Proxy qr - -> Proxy mut - -> Proxy sub +graphQLAppTrans :: + ( GraphQLApp p qr mut sub m chn hs ) + => (forall a. m a -> ServerErrorIO a) + -> ServerT chn GQL.Field p m hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> Application graphQLAppTrans :: (forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs @@ -232,12 +232,12 @@ forall k (t :: k). Proxy t -> Proxy mut -> Proxy sub -> Application -graphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s +graphQLAppTrans forall a. m a -> ServerErrorIO a +f ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s = ConnectionOptions -> ServerApp -> Application -> Application WS.websocketsOr ConnectionOptions WS.defaultConnectionOptions @@ -258,11 +258,11 @@ GraphQLApp p qr mut sub m chn hs => -> Proxy sub -> ServerApp wsGraphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s) +f ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s) ((forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs -> Proxy qr @@ -280,19 +280,19 @@ GraphQLApp p qr mut sub m chn hs => -> Proxy sub -> Application httpGraphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s) +f ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s) -httpGraphQLAppTrans :: - ( GraphQLApp p qr mut sub m chn hs ) - => (forall a. m a -> ServerErrorIO a) - -> ServerT chn GQL.Field p m hs - -> Proxy qr - -> Proxy mut - -> Proxy sub +httpGraphQLAppTrans :: + ( GraphQLApp p qr mut sub m chn hs ) + => (forall a. m a -> ServerErrorIO a) + -> ServerT chn GQL.Field p m hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> Application httpGraphQLAppTrans :: (forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs @@ -300,39 +300,39 @@ GraphQLApp p qr mut sub m chn hs => -> Proxy mut -> Proxy sub -> Application -httpGraphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s Request -req Response -> IO ResponseReceived -res = +httpGraphQLAppTrans forall a. m a -> ServerErrorIO a +f ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s Request +req Response -> IO ResponseReceived +res = case Method -> Either Method StdMethod parseMethod (Request -> Method requestMethod Request -req) of - Left Method -err -> Text -> IO ResponseReceived -toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived +req) of + Left Method +err -> Text -> IO ResponseReceived +toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ (UnicodeException -> Text) -> (Text -> Text) -> Either UnicodeException Text -> Text forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either UnicodeException -> Text -unpackUnicodeException Text -> Text +unpackUnicodeException Text -> Text forall a. a -> a id (Method -> Either UnicodeException Text decodeUtf8' Method -err) +err) Right StdMethod GET -> do - let qst :: Query -qst = Request -> Query + let qst :: Query +qst = Request -> Query queryString Request -req - opN :: Maybe (Either UnicodeException Text) -opN = Method -> Either UnicodeException Text +req + opN :: Maybe (Either UnicodeException Text) +opN = Method -> Either UnicodeException Text decodeUtf8' (Method -> Either UnicodeException Text) -> Maybe Method -> Maybe (Either UnicodeException Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -342,9 +342,9 @@ forall (m :: * -> *) a. Monad m => m (m a) -> m a forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Method "operationName" Query -qst) - decodedQuery :: Maybe (Either UnicodeException Text) -decodedQuery = (Method -> Either UnicodeException Text) +qst) + decodedQuery :: Maybe (Either UnicodeException Text) +decodedQuery = (Method -> Either UnicodeException Text) -> Maybe Method -> Maybe (Either UnicodeException Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Method -> Either UnicodeException Text @@ -355,16 +355,16 @@ forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Method "query" Query -qst +qst case (Maybe (Either UnicodeException Text) -decodedQuery, Method -> Query -> Maybe (Maybe Method) +decodedQuery, Method -> Query -> Maybe (Maybe Method) forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Method "variables" Query -qst) of - (Just (Right Text -qry), Just (Just Method -vars)) -> +qst) of + (Just (Right Text +qry), Just (Just Method +vars)) -> case ByteString -> Either String VariableMapC forall a. FromJSON a => ByteString -> Either String a A.eitherDecode (ByteString -> Either String VariableMapC) @@ -372,74 +372,74 @@ forall a. FromJSON a => ByteString -> Either String a forall a b. (a -> b) -> a -> b $ Method -> ByteString fromStrict Method -vars of - Left String -err -> Text -> IO ResponseReceived -toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived +vars of + Left String +err -> Text -> IO ResponseReceived +toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ String -> Text T.pack String -err - Right VariableMapC -vrs -> case Maybe (Either UnicodeException Text) +err + Right VariableMapC +vrs -> case Maybe (Either UnicodeException Text) -> Either UnicodeException (Maybe Text) forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence Maybe (Either UnicodeException Text) -opN of - Left UnicodeException -err -> Text -> IO ResponseReceived -toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived +opN of + Left UnicodeException +err -> Text -> IO ResponseReceived +toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ Text "Could not parse operation name: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UnicodeException -> Text -unpackUnicodeException UnicodeException -err - Right Maybe Text -opName -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived -execQuery Maybe Text -opName VariableMapC -vrs Text -qry - (Just (Right Text -qry), Maybe (Maybe Method) +unpackUnicodeException UnicodeException +err + Right Maybe Text +opName -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived +execQuery Maybe Text +opName VariableMapC +vrs Text +qry + (Just (Right Text +qry), Maybe (Maybe Method) _) -> case Maybe (Either UnicodeException Text) -> Either UnicodeException (Maybe Text) forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence Maybe (Either UnicodeException Text) -opN of - Left UnicodeException -err -> Text -> IO ResponseReceived -toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived +opN of + Left UnicodeException +err -> Text -> IO ResponseReceived +toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ Text "Could not parse query: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UnicodeException -> Text -unpackUnicodeException UnicodeException -err - Right Maybe Text -opName -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived -execQuery Maybe Text -opName VariableMapC +unpackUnicodeException UnicodeException +err + Right Maybe Text +opName -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived +execQuery Maybe Text +opName VariableMapC forall k v. HashMap k v HM.empty Text -qry +qry (Maybe (Either UnicodeException Text), Maybe (Maybe Method)) _ -> Text -> IO ResponseReceived -toError Text +toError Text "Error parsing query" Right StdMethod POST -> do - ByteString -body <- Request -> IO ByteString + ByteString +body <- Request -> IO ByteString strictRequestBody Request -req +req case Char -> Method -> [Method] split Char ';' (Method -> [Method]) -> Maybe Method -> Maybe [Method] @@ -449,29 +449,29 @@ forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup HeaderName hContentType (Request -> [(HeaderName, Method)] requestHeaders Request -req) of +req) of Just (Method "application/json" : [Method] _) -> case ByteString -> Either String GraphQLInput forall a. FromJSON a => ByteString -> Either String a A.eitherDecode ByteString -body of - Left String -err -> Text -> IO ResponseReceived -toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived +body of + Left String +err -> Text -> IO ResponseReceived +toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ String -> Text T.pack String -err - Right (GraphQLInput Text -qry VariableMapC -vars Maybe Text -opName) -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived -execQuery Maybe Text -opName VariableMapC -vars Text -qry +err + Right (GraphQLInput Text +qry VariableMapC +vars Maybe Text +opName) -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived +execQuery Maybe Text +opName VariableMapC +vars Text +qry Just (Method "application/graphql" : [Method] _) -> @@ -481,49 +481,49 @@ forall a b. (a -> b) -> a -> b forall a b. (a -> b) -> a -> b $ ByteString -> Method toStrict ByteString -body of - Left UnicodeException -err -> Text -> IO ResponseReceived -toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived +body of + Left UnicodeException +err -> Text -> IO ResponseReceived +toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ Text "Could not decode utf8 from body: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UnicodeException -> Text -unpackUnicodeException UnicodeException -err - Right Text -msg -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived -execQuery Maybe Text +unpackUnicodeException UnicodeException +err + Right Text +msg -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived +execQuery Maybe Text forall a. Maybe a Nothing VariableMapC forall k v. HashMap k v HM.empty Text -msg +msg Maybe [Method] _ -> Text -> IO ResponseReceived -toError Text +toError Text "No `Content-Type` header found!" Either Method StdMethod _ -> Text -> IO ResponseReceived -toError Text +toError Text "Unsupported method" where - execQuery :: Maybe T.Text -> VariableMapC -> T.Text -> IO ResponseReceived - execQuery :: Maybe Text -> VariableMapC -> Text -> IO ResponseReceived -execQuery Maybe Text -opn VariableMapC -vals Text -qry = + execQuery :: Maybe T.Text -> VariableMapC -> T.Text -> IO ResponseReceived + execQuery :: Maybe Text -> VariableMapC -> Text -> IO ResponseReceived +execQuery Maybe Text +opn VariableMapC +vals Text +qry = case Text -> Either Text [Definition] parseDoc Text -qry of - Left Text -err -> Text -> IO ResponseReceived -toError Text -err - Right [Definition] -doc -> (forall a. m a -> ServerErrorIO a) +qry of + Left Text +err -> Text -> IO ResponseReceived +toError Text +err + Right [Definition] +doc -> (forall a. m a -> ServerErrorIO a) -> [(HeaderName, Method)] -> ServerT chn Field p m hs -> Proxy qr @@ -548,25 +548,25 @@ GraphQLApp p qr mut sub m chn hs => -> [Definition] -> IO Value runPipeline forall a. m a -> ServerErrorIO a -f (Request -> [(HeaderName, Method)] +f (Request -> [(HeaderName, Method)] requestHeaders Request -req) ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s Maybe Text -opn VariableMapC -vals [Definition] -doc +req) ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s Maybe Text +opn VariableMapC +vals [Definition] +doc IO Value -> (Value -> IO ResponseReceived) -> IO ResponseReceived forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Value -> IO ResponseReceived -toResponse - toError :: T.Text -> IO ResponseReceived - toError :: Text -> IO ResponseReceived -toError Text -err = Value -> IO ResponseReceived -toResponse (Value -> IO ResponseReceived) -> Value -> IO ResponseReceived +toResponse + toError :: T.Text -> IO ResponseReceived + toError :: Text -> IO ResponseReceived +toError Text +err = Value -> IO ResponseReceived +toResponse (Value -> IO ResponseReceived) -> Value -> IO ResponseReceived forall a b. (a -> b) -> a -> b $ [Pair] -> Value A.object [ (Text @@ -575,11 +575,11 @@ forall a b. (a -> b) -> a -> b A.object [ (Text "message", Text -> Value A.String Text -err) ] ])] - toResponse :: A.Value -> IO ResponseReceived - toResponse :: Value -> IO ResponseReceived -toResponse = Response -> IO ResponseReceived -res (Response -> IO ResponseReceived) +err) ] ])] + toResponse :: A.Value -> IO ResponseReceived + toResponse :: Value -> IO ResponseReceived +toResponse = Response -> IO ResponseReceived +res (Response -> IO ResponseReceived) -> (Value -> Response) -> Value -> IO ResponseReceived forall b c a. (b -> c) -> (a -> b) -> a -> c . Status -> [(HeaderName, Method)] -> Builder -> Response @@ -592,26 +592,26 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Text forall a. ToJSON a => a -> Text encodeToLazyText - unpackUnicodeException :: UnicodeException -> T.Text - unpackUnicodeException :: UnicodeException -> Text -unpackUnicodeException (DecodeError String -str Maybe Word8 + unpackUnicodeException :: UnicodeException -> T.Text + unpackUnicodeException :: UnicodeException -> Text +unpackUnicodeException (DecodeError String +str Maybe Word8 _) = String -> Text T.pack String -str - unpackUnicodeException UnicodeException +str + unpackUnicodeException UnicodeException _ = String -> Text forall a. HasCallStack => String -> a error String "EncodeError is deprecated" -wsGraphQLAppTrans - :: ( GraphQLApp p qr mut sub m chn hs ) - => (forall a. m a -> ServerErrorIO a) - -> ServerT chn GQL.Field p m hs - -> Proxy qr - -> Proxy mut - -> Proxy sub +wsGraphQLAppTrans + :: ( GraphQLApp p qr mut sub m chn hs ) + => (forall a. m a -> ServerErrorIO a) + -> ServerT chn GQL.Field p m hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> WS.ServerApp wsGraphQLAppTrans :: (forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs @@ -619,46 +619,46 @@ forall a. HasCallStack => String -> a -> Proxy mut -> Proxy sub -> ServerApp -wsGraphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s PendingConnection -conn - = do let headers :: [(HeaderName, Method)] -headers = RequestHead -> [(HeaderName, Method)] +wsGraphQLAppTrans forall a. m a -> ServerErrorIO a +f ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s PendingConnection +conn + = do let headers :: [(HeaderName, Method)] +headers = RequestHead -> [(HeaderName, Method)] WS.requestHeaders (RequestHead -> [(HeaderName, Method)]) -> RequestHead -> [(HeaderName, Method)] forall a b. (a -> b) -> a -> b $ PendingConnection -> RequestHead WS.pendingRequest PendingConnection -conn +conn case HeaderName -> [(HeaderName, Method)] -> Maybe Method forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup HeaderName "Sec-WebSocket-Protocol" [(HeaderName, Method)] -headers of - Just Method -v +headers of + Just Method +v | Method -v Method -> Method -> Bool +v Method -> Method -> Bool forall a. Eq a => a -> a -> Bool == Method "graphql-ws" Bool -> Bool -> Bool || Method -v Method -> Method -> Bool +v Method -> Method -> Bool forall a. Eq a => a -> a -> Bool == Method "graphql-transport-ws" - -> do Connection -conn' <- PendingConnection -> AcceptRequest -> IO Connection + -> do Connection +conn' <- PendingConnection -> AcceptRequest -> IO Connection WS.acceptRequestWith PendingConnection -conn (Maybe Method -> [(HeaderName, Method)] -> AcceptRequest +conn (Maybe Method -> [(HeaderName, Method)] -> AcceptRequest WS.AcceptRequest (Method -> Maybe Method forall a. a -> Maybe a Just Method -v) []) +v) []) ((Maybe Text -> VariableMapC -> [Definition] @@ -680,7 +680,7 @@ forall a b c. (a -> b -> c) -> b -> a -> c -> IO ()) -> Connection -> IO () protocol Connection -conn' ((Maybe Text +conn' ((Maybe Text -> VariableMapC -> [Definition] -> ConduitT Value Void IO () @@ -721,28 +721,28 @@ GraphQLApp p qr mut sub m chn hs => -> ConduitT Value Void IO () -> IO () runSubscriptionPipeline forall a. m a -> ServerErrorIO a -f [(HeaderName, Method)] -headers ServerT chn Field p m hs -server Proxy qr -q Proxy mut -m Proxy sub -s +f [(HeaderName, Method)] +headers ServerT chn Field p m hs +server Proxy qr +q Proxy mut +m Proxy sub +s Maybe Method _ -> PendingConnection -> Method -> IO () WS.rejectRequest PendingConnection -conn Method +conn Method "unsupported protocol" -- | Run a Mu 'graphQLApp' using the given 'Settings'. -- -- Go to 'Network.Wai.Handler.Warp' to declare 'Settings'. -runGraphQLAppSettings :: - ( GraphQLApp p qr mut sub ServerErrorIO chn hs ) +runGraphQLAppSettings :: + ( GraphQLApp p qr mut sub ServerErrorIO chn hs ) => Settings - -> ServerT chn GQL.Field p ServerErrorIO hs - -> Proxy qr - -> Proxy mut - -> Proxy sub + -> ServerT chn GQL.Field p ServerErrorIO hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> IO () runGraphQLAppSettings :: Settings -> ServerT chn Field p ServerErrorIO hs @@ -750,14 +750,14 @@ GraphQLApp p qr mut sub m chn hs => -> Proxy mut -> Proxy sub -> IO () -runGraphQLAppSettings Settings -st ServerT chn Field p ServerErrorIO hs -svr Proxy qr -q Proxy mut -m Proxy sub -s = Settings -> Application -> IO () +runGraphQLAppSettings Settings +st ServerT chn Field p ServerErrorIO hs +svr Proxy qr +q Proxy mut +m Proxy sub +s = Settings -> Application -> IO () runSettings Settings -st (ServerT chn Field p ServerErrorIO hs +st (ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Proxy mut -> Proxy sub -> Application forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol) (chn :: ServiceChain Symbol) (hs :: [[*]]). @@ -765,19 +765,19 @@ GraphQLApp p qr mut sub ServerErrorIO chn hs => ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Proxy mut -> Proxy sub -> Application graphQLApp ServerT chn Field p ServerErrorIO hs -svr Proxy qr -q Proxy mut -m Proxy sub -s) +svr Proxy qr +q Proxy mut +m Proxy sub +s) -- | Run a Mu 'graphQLApp' on the given port. -runGraphQLApp :: - ( GraphQLApp p qr mut sub ServerErrorIO chn hs ) +runGraphQLApp :: + ( GraphQLApp p qr mut sub ServerErrorIO chn hs ) => Port - -> ServerT chn GQL.Field p ServerErrorIO hs - -> Proxy qr - -> Proxy mut - -> Proxy sub + -> ServerT chn GQL.Field p ServerErrorIO hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> IO () runGraphQLApp :: Port -> ServerT chn Field p ServerErrorIO hs @@ -785,14 +785,14 @@ ServerT chn Field p ServerErrorIO hs -> Proxy mut -> Proxy sub -> IO () -runGraphQLApp Port -port ServerT chn Field p ServerErrorIO hs -svr Proxy qr -q Proxy mut -m Proxy sub -s = Port -> Application -> IO () +runGraphQLApp Port +port ServerT chn Field p ServerErrorIO hs +svr Proxy qr +q Proxy mut +m Proxy sub +s = Port -> Application -> IO () run Port -port (ServerT chn Field p ServerErrorIO hs +port (ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Proxy mut -> Proxy sub -> Application forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol) (chn :: ServiceChain Symbol) (hs :: [[*]]). @@ -800,20 +800,20 @@ GraphQLApp p qr mut sub ServerErrorIO chn hs => ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Proxy mut -> Proxy sub -> Application graphQLApp ServerT chn Field p ServerErrorIO hs -svr Proxy qr -q Proxy mut -m Proxy sub -s) +svr Proxy qr +q Proxy mut +m Proxy sub +s) -- | Run a Mu 'graphQLApp' on a transformer stack on the given port. -runGraphQLAppTrans :: - ( GraphQLApp p qr mut sub m chn hs ) +runGraphQLAppTrans :: + ( GraphQLApp p qr mut sub m chn hs ) => Port - -> (forall a. m a -> ServerErrorIO a) - -> ServerT chn GQL.Field p m hs - -> Proxy qr - -> Proxy mut - -> Proxy sub + -> (forall a. m a -> ServerErrorIO a) + -> ServerT chn GQL.Field p m hs + -> Proxy qr + -> Proxy mut + -> Proxy sub -> IO () runGraphQLAppTrans :: Port -> (forall a. m a -> ServerErrorIO a) @@ -822,15 +822,15 @@ ServerT chn Field p ServerErrorIO hs -> Proxy mut -> Proxy sub -> IO () -runGraphQLAppTrans Port -port forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -svr Proxy qr -q Proxy mut -m Proxy sub -s = Port -> Application -> IO () +runGraphQLAppTrans Port +port forall a. m a -> ServerErrorIO a +f ServerT chn Field p m hs +svr Proxy qr +q Proxy mut +m Proxy sub +s = Port -> Application -> IO () run Port -port ((forall a. m a -> ServerErrorIO a) +port ((forall a. m a -> ServerErrorIO a) -> ServerT chn Field p m hs -> Proxy qr -> Proxy mut @@ -847,33 +847,33 @@ GraphQLApp p qr mut sub m chn hs => -> Proxy sub -> Application graphQLAppTrans forall a. m a -> ServerErrorIO a -f ServerT chn Field p m hs -svr Proxy qr -q Proxy mut -m Proxy sub -s) +f ServerT chn Field p m hs +svr Proxy qr +q Proxy mut +m Proxy sub +s) -- | Run a query-only Mu 'graphQLApp' on the given port. -runGraphQLAppQuery :: - ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs ) +runGraphQLAppQuery :: + ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs ) => Port - -> ServerT chn GQL.Field p ServerErrorIO hs - -> Proxy qr + -> ServerT chn GQL.Field p ServerErrorIO hs + -> Proxy qr -> IO () runGraphQLAppQuery :: Port -> ServerT chn Field p ServerErrorIO hs -> Proxy qr -> IO () -runGraphQLAppQuery Port -port ServerT chn Field p ServerErrorIO hs -svr Proxy qr -q = Port -> Application -> IO () +runGraphQLAppQuery Port +port ServerT chn Field p ServerErrorIO hs +svr Proxy qr +q = Port -> Application -> IO () run Port -port (ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application +port (ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application forall (qr :: Symbol) (p :: Package') (chn :: ServiceChain Symbol) (hs :: [[*]]). GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs => ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application graphQLAppQuery ServerT chn Field p ServerErrorIO hs -svr Proxy qr -q) +svr Proxy qr +q) -- | Turns a 'Conduit' working on 'ServerErrorIO' -- into any other base monad which supports 'IO', @@ -882,9 +882,9 @@ ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application -- This function is useful to interoperate with -- libraries which generate 'Conduit's with other -- base monads, such as @persistent@. -liftServerConduit - :: MonadIO m - => ConduitT i o ServerErrorIO r -> ConduitT i o m r +liftServerConduit + :: MonadIO m + => ConduitT i o ServerErrorIO r -> ConduitT i o m r liftServerConduit :: ConduitT i o ServerErrorIO r -> ConduitT i o m r liftServerConduit = (forall a. ServerErrorIO a -> m a) -> ConduitT i o ServerErrorIO r -> ConduitT i o m r @@ -893,31 +893,31 @@ Monad m => (forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r transPipe forall a. ServerErrorIO a -> m a forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a -raiseErrors - where raiseErrors :: forall m a. MonadIO m => ServerErrorIO a -> m a - raiseErrors :: ServerErrorIO a -> m a -raiseErrors ServerErrorIO a -h +raiseErrors + where raiseErrors :: forall m a. MonadIO m => ServerErrorIO a -> m a + raiseErrors :: ServerErrorIO a -> m a +raiseErrors ServerErrorIO a +h = IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO a -> m a) -> IO a -> m a forall a b. (a -> b) -> a -> b $ do - Either ServerError a -h' <- ServerErrorIO a -> IO (Either ServerError a) + Either ServerError a +h' <- ServerErrorIO a -> IO (Either ServerError a) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT ServerErrorIO a -h +h case Either ServerError a -h' of - Right a -r -> a -> IO a +h' of + Right a +r -> a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure a -r - Left ServerError -e -> ServerError -> IO a +r + Left ServerError +e -> ServerError -> IO a forall a e. Exception e => e -> a throw ServerError -e +e \ No newline at end of file diff --git a/wip/haddock/mu-graphql/src/Mu.GraphQL.Subscription.Protocol.html b/wip/haddock/mu-graphql/src/Mu.GraphQL.Subscription.Protocol.html index 44e06bd..c766f4f 100644 --- a/wip/haddock/mu-graphql/src/Mu.GraphQL.Subscription.Protocol.html +++ b/wip/haddock/mu-graphql/src/Mu.GraphQL.Subscription.Protocol.html @@ -36,35 +36,35 @@ https://github.com/apollographql/subscriptions-transport-ws/blob/master/PROTOCOL -> ConduitT Value Void IO () -> IO ()) -> Connection -> IO () -protocol Maybe Text +protocol Maybe Text -> VariableMapC -> [Definition] -> ConduitT Value Void IO () -> IO () -f Connection -conn = IO () -start +f Connection +conn = IO () +start where -- listen for GQL_CONNECTION_INIT - start :: IO () -start = do - Maybe ClientMessage -msg <- Connection -> IO (Maybe ClientMessage) + start :: IO () +start = do + Maybe ClientMessage +msg <- Connection -> IO (Maybe ClientMessage) forall a. FromJSON a => Connection -> IO (Maybe a) receiveJSON Connection -conn +conn case Maybe ClientMessage -msg of +msg of Just (GQLConnectionInit Maybe Value _) -> do -- send GQL_CONNECTION_ACK Connection -> ServerMessage -> IO () forall a. ToJSON a => Connection -> a -> IO () sendJSON Connection -conn ServerMessage +conn ServerMessage GQLConnectionAck - Map Text (Async ()) -vars <- IO (Map Text (Async ())) + Map Text (Async ()) +vars <- IO (Map Text (Async ())) forall key value. IO (Map key value) M.newIO -- send GQL_KEEP_ALIVE each 1s. @@ -72,57 +72,57 @@ forall key value. IO (Map key value) forall a b. IO a -> (Async a -> IO b) -> IO b withAsync IO Any forall b. IO b -keepAlive ((Async Any -> IO ()) -> IO ()) -> (Async Any -> IO ()) -> IO () +keepAlive ((Async Any -> IO ()) -> IO ()) -> (Async Any -> IO ()) -> IO () forall a b. (a -> b) -> a -> b -$ \Async Any -ka -> +$ \Async Any +ka -> -- start listening for incoming messages Async Any -> Map Text (Async ()) -> IO () forall a. Async a -> Map Text (Async ()) -> IO () -listen Async Any -ka Map Text (Async ()) -vars +listen Async Any +ka Map Text (Async ()) +vars Maybe ClientMessage _ -> IO () -start -- Keep waiting +start -- Keep waiting -- keep-alive - keepAlive :: IO b -keepAlive = do + keepAlive :: IO b +keepAlive = do Connection -> ServerMessage -> IO () forall a. ToJSON a => Connection -> a -> IO () sendJSON Connection -conn ServerMessage +conn ServerMessage GQLKeepAlive Int -> IO () threadDelay Int 1000000 IO b -keepAlive +keepAlive -- listen for messages from client - listen :: Async a -> Map Text (Async ()) -> IO () -listen Async a -ka Map Text (Async ()) -vars = do - Maybe ClientMessage -msg <- Connection -> IO (Maybe ClientMessage) + listen :: Async a -> Map Text (Async ()) -> IO () +listen Async a +ka Map Text (Async ()) +vars = do + Maybe ClientMessage +msg <- Connection -> IO (Maybe ClientMessage) forall a. FromJSON a => Connection -> IO (Maybe a) receiveJSON Connection -conn +conn case Maybe ClientMessage -msg of - Just (GQLStart Text -i Text -q VariableMapC -v Maybe Text -o) -- start handling +msg of + Just (GQLStart Text +i Text +q VariableMapC +v Maybe Text +o) -- start handling -> IO () -> (Async () -> IO ()) -> IO () forall a b. IO a -> (Async a -> IO b) -> IO b withAsync (Text -> Text -> VariableMapC -> Maybe Text -> IO () -handle Text -i Text -q VariableMapC -v Maybe Text -o IO () -> IO () -> IO () +handle Text +i Text +q VariableMapC +v Maybe Text +o IO () -> IO () -> IO () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> STM () -> IO () forall a. STM a -> IO a @@ -131,11 +131,11 @@ forall key value. (Eq key, Hashable key) => key -> Map key value -> STM () M.delete Text -i Map Text (Async ()) -vars)) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO () +i Map Text (Async ()) +vars)) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO () forall a b. (a -> b) -> a -> b -$ \Async () -t -> do +$ \Async () +t -> do STM () -> IO () forall a. STM a -> IO a atomically (STM () -> IO ()) -> STM () -> IO () @@ -145,17 +145,17 @@ forall key value. (Eq key, Hashable key) => value -> key -> Map key value -> STM () M.insert Async () -t Text -i Map Text (Async ()) -vars +t Text +i Map Text (Async ()) +vars Async a -> Map Text (Async ()) -> IO () -listen Async a -ka Map Text (Async ()) -vars - Just (GQLStop Text -i) -- stop with handling that query - -> do Maybe (Async ()) -r <- STM (Maybe (Async ())) -> IO (Maybe (Async ())) +listen Async a +ka Map Text (Async ()) +vars + Just (GQLStop Text +i) -- stop with handling that query + -> do Maybe (Async ()) +r <- STM (Maybe (Async ())) -> IO (Maybe (Async ())) forall a. STM a -> IO a atomically (STM (Maybe (Async ())) -> IO (Maybe (Async ()))) -> STM (Maybe (Async ())) -> IO (Maybe (Async ())) @@ -165,19 +165,19 @@ forall key value. (Eq key, Hashable key) => key -> Map key value -> STM (Maybe value) M.lookup Text -i Map Text (Async ()) -vars +i Map Text (Async ()) +vars case Maybe (Async ()) -r of +r of Maybe (Async ()) Nothing -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () - Just Async () -a -> do Async () -> IO () + Just Async () +a -> do Async () -> IO () forall a. Async a -> IO () cancel Async () -a +a STM () -> IO () forall a. STM a -> IO a atomically (STM () -> IO ()) -> STM () -> IO () @@ -187,109 +187,109 @@ forall key value. (Eq key, Hashable key) => key -> Map key value -> STM () M.delete Text -i Map Text (Async ()) -vars +i Map Text (Async ()) +vars Async a -> Map Text (Async ()) -> IO () -listen Async a -ka Map Text (Async ()) -vars +listen Async a +ka Map Text (Async ()) +vars Just ClientMessage GQLTerminate -- terminate all queries -> do Async a -> Map Text (Async ()) -> IO () forall a a a. Async a -> Map a (Async a) -> IO () -cancelAll Async a -ka Map Text (Async ()) -vars +cancelAll Async a +ka Map Text (Async ()) +vars Connection -> Text -> IO () forall a. WebSocketsData a => Connection -> a -> IO () sendClose Connection -conn (Text +conn (Text "GraphQL session terminated" :: T.Text) Maybe ClientMessage _ -> Async a -> Map Text (Async ()) -> IO () -listen Async a -ka Map Text (Async ()) -vars -- Keep going +listen Async a +ka Map Text (Async ()) +vars -- Keep going -- Handle a single query - handle :: Text -> Text -> VariableMapC -> Maybe Text -> IO () -handle Text -i Text -q VariableMapC -v Maybe Text -o + handle :: Text -> Text -> VariableMapC -> Maybe Text -> IO () +handle Text +i Text +q VariableMapC +v Maybe Text +o = case Text -> Either Text [Definition] P.parseDoc Text -q of - Left Text -err -> Connection -> ServerMessage -> IO () +q of + Left Text +err -> Connection -> ServerMessage -> IO () forall a. ToJSON a => Connection -> a -> IO () sendJSON Connection -conn (Text -> Value -> ServerMessage +conn (Text -> Value -> ServerMessage GQLError Text -i (Text -> Value +i (Text -> Value forall a. ToJSON a => a -> Value A.toJSON Text -err)) - Right [Definition] -d -> do +err)) + Right [Definition] +d -> do Maybe Text -> VariableMapC -> [Definition] -> ConduitT Value Void IO () -> IO () -f Maybe Text -o VariableMapC -v [Definition] -d (Text -> ConduitT Value Void IO () +f Maybe Text +o VariableMapC +v [Definition] +d (Text -> ConduitT Value Void IO () forall (m :: * -> *) o. MonadIO m => Text -> ConduitT Value o m () -cndt Text -i) +cndt Text +i) Connection -> ServerMessage -> IO () forall a. ToJSON a => Connection -> a -> IO () sendJSON Connection -conn (Text -> ServerMessage +conn (Text -> ServerMessage GQLComplete Text -i) +i) -- Conduit which sends the results via the wire - cndt :: Text -> ConduitT Value o m () -cndt Text -i = do - Maybe Value -msg <- ConduitT Value o m (Maybe Value) + cndt :: Text -> ConduitT Value o m () +cndt Text +i = do + Maybe Value +msg <- ConduitT Value o m (Maybe Value) forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i) await case Maybe Value -msg of +msg of Maybe Value Nothing -> () -> ConduitT Value o m () forall (m :: * -> *) a. Monad m => a -> m a return () - Just Value -v -> do IO () -> ConduitT Value o m () + Just Value +v -> do IO () -> ConduitT Value o m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ConduitT Value o m ()) -> IO () -> ConduitT Value o m () forall a b. (a -> b) -> a -> b $ Connection -> ServerMessage -> IO () forall a. ToJSON a => Connection -> a -> IO () sendJSON Connection -conn (Text -> Value -> ServerMessage +conn (Text -> Value -> ServerMessage GQLData Text -i Value -v) +i Value +v) Text -> ConduitT Value o m () -cndt Text -i +cndt Text +i -- Cancel all pending subscriptions - cancelAll :: Async a -> Map a (Async a) -> IO () -cancelAll Async a -ka Map a (Async a) -vars + cancelAll :: Async a -> Map a (Async a) -> IO () +cancelAll Async a +ka Map a (Async a) +vars = do Async a -> IO () forall a. Async a -> IO () cancel Async a -ka - [(a, Async a)] -vs <- STM [(a, Async a)] -> IO [(a, Async a)] +ka + [(a, Async a)] +vs <- STM [(a, Async a)] -> IO [(a, Async a)] forall a. STM a -> IO a atomically (STM [(a, Async a)] -> IO [(a, Async a)]) -> STM [(a, Async a)] -> IO [(a, Async a)] @@ -302,7 +302,7 @@ forall a b. (a -> b) -> a -> b $ Map a (Async a) -> ListT STM (a, Async a) forall key value. Map key value -> ListT STM (key, value) M.listT Map a (Async a) -vars +vars [Async a] -> (Async a -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => @@ -312,19 +312,19 @@ forall a b. (a -> b) -> [a] -> [b] map (a, Async a) -> Async a forall a b. (a, b) -> b snd [(a, Async a)] -vs) Async a -> IO () +vs) Async a -> IO () forall a. Async a -> IO () cancel -receiveJSON :: A.FromJSON a => Connection -> IO (Maybe a) +receiveJSON :: A.FromJSON a => Connection -> IO (Maybe a) receiveJSON :: Connection -> IO (Maybe a) -receiveJSON Connection -conn = do - ByteString -d <- Connection -> IO ByteString +receiveJSON Connection +conn = do + ByteString +d <- Connection -> IO ByteString forall a. WebSocketsData a => Connection -> IO a receiveData Connection -conn +conn Maybe a -> IO (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a) @@ -332,20 +332,20 @@ forall a b. (a -> b) -> a -> b $ ByteString -> Maybe a forall a. FromJSON a => ByteString -> Maybe a A.decode ByteString -d +d -sendJSON :: A.ToJSON a => Connection -> a -> IO () +sendJSON :: A.ToJSON a => Connection -> a -> IO () sendJSON :: Connection -> a -> IO () -sendJSON Connection -conn a -v +sendJSON Connection +conn a +v = Connection -> ByteString -> IO () forall a. WebSocketsData a => Connection -> a -> IO () sendTextData Connection -conn (a -> ByteString +conn (a -> ByteString forall a. ToJSON a => a -> ByteString A.encode a -v) +v) data ClientMessage = GQLConnectionInit { ClientMessage -> Maybe Value @@ -360,7 +360,7 @@ forall a. ToJSON a => a -> ByteString operationName :: Maybe T.Text} | GQLStop { clientMsgId :: T.Text } | GQLTerminate - deriving Int -> ClientMessage -> ShowS + deriving Int -> ClientMessage -> ShowS [ClientMessage] -> ShowS ClientMessage -> String (Int -> ClientMessage -> ShowS) @@ -389,7 +389,7 @@ $cshowsPrec :: Int -> ClientMessage -> ShowS , payload :: A.Value } | GQLComplete { serverMsgId :: T.Text} | GQLKeepAlive - deriving Int -> ServerMessage -> ShowS + deriving Int -> ServerMessage -> ShowS [ServerMessage] -> ShowS ServerMessage -> String (Int -> ServerMessage -> ShowS) @@ -409,8 +409,8 @@ $cshowsPrec :: Int -> ServerMessage -> ShowS -- NOTE: using https://github.com/apollographql/subscriptions-transport-ws/blob/master/src/message-types.ts -- as source of truth for the message types -instance A.FromJSON ClientMessage where - parseJSON :: Value -> Parser ClientMessage +instance A.FromJSON ClientMessage where + parseJSON :: Value -> Parser ClientMessage parseJSON = String -> (Object -> Parser ClientMessage) -> Value @@ -422,16 +422,16 @@ forall a. String -> (Object -> Parser a) -> Value -> Parser a -> Value -> Parser ClientMessage forall a b. (a -> b) -> a -> b -$ \Object -v -> do - String -ty :: String <- Object -v Object -> Text -> Parser String +$ \Object +v -> do + String +ty :: String <- Object +v Object -> Text -> Parser String forall a. FromJSON a => Object -> Text -> Parser a .: Text "type" case String -ty of +ty of String "connection_init" -> Maybe Value -> ClientMessage @@ -439,23 +439,23 @@ forall a. FromJSON a => Object -> Text -> Parser a -> Parser (Maybe Value) -> Parser ClientMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object -v Object -> Text -> Parser (Maybe Value) +v Object -> Text -> Parser (Maybe Value) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? Text "payload" String "start" - -> do Text -i <- Object -v Object -> Text -> Parser Text + -> do Text +i <- Object +v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: Text "id" - (Text -q,VariableMapC -vrs,Maybe Text -opN) <- Object -v Object -> Text -> Parser Value + (Text +q,VariableMapC +vrs,Maybe Text +opN) <- Object +v Object -> Text -> Parser Value forall a. FromJSON a => Object -> Text -> Parser a .: Text "payload" Parser Value @@ -463,7 +463,7 @@ forall a. FromJSON a => Object -> Text -> Parser a -> Parser (Text, VariableMapC, Maybe Text) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Value -> Parser (Text, VariableMapC, Maybe Text) -parsePayload +parsePayload ClientMessage -> Parser ClientMessage forall (f :: * -> *) a. Applicative f => a -> f a pure (ClientMessage -> Parser ClientMessage) @@ -471,17 +471,17 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a b. (a -> b) -> a -> b $ Text -> Text -> VariableMapC -> Maybe Text -> ClientMessage GQLStart Text -i Text -q VariableMapC -vrs Maybe Text -opN +i Text +q VariableMapC +vrs Maybe Text +opN String "stop" -> Text -> ClientMessage GQLStop (Text -> ClientMessage) -> Parser Text -> Parser ClientMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object -v Object -> Text -> Parser Text +v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: Text "id" @@ -496,8 +496,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall (f :: * -> *) a. Alternative f => f a empty where - parsePayload :: Value -> Parser (Text, VariableMapC, Maybe Text) -parsePayload = String + parsePayload :: Value -> Parser (Text, VariableMapC, Maybe Text) +parsePayload = String -> (Object -> Parser (Text, VariableMapC, Maybe Text)) -> Value -> Parser (Text, VariableMapC, Maybe Text) @@ -510,15 +510,15 @@ forall a. String -> (Object -> Parser a) -> Value -> Parser a -> Parser (Text, VariableMapC, Maybe Text) forall a b. (a -> b) -> a -> b $ - \Object -v -> (,,) (Text + \Object +v -> (,,) (Text -> VariableMapC -> Maybe Text -> (Text, VariableMapC, Maybe Text)) -> Parser Text -> Parser (VariableMapC -> Maybe Text -> (Text, VariableMapC, Maybe Text)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Object -v Object -> Text -> Parser Text +v Object -> Text -> Parser Text forall a. FromJSON a => Object -> Text -> Parser a .: Text "query" @@ -528,7 +528,7 @@ forall a. FromJSON a => Object -> Text -> Parser a -> Parser (Maybe Text -> (Text, VariableMapC, Maybe Text)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Object -v Object -> Text -> Parser VariableMapC +v Object -> Text -> Parser VariableMapC forall a. FromJSON a => Object -> Text -> Parser a .: Text "variables" Parser VariableMapC -> Parser VariableMapC -> Parser VariableMapC @@ -542,24 +542,24 @@ forall k v. HashMap k v -> Parser (Maybe Text) -> Parser (Text, VariableMapC, Maybe Text) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object -v Object -> Text -> Parser (Maybe Text) +v Object -> Text -> Parser (Maybe Text) forall a. FromJSON a => Object -> Text -> Parser (Maybe a) .:? Text "operationName" -theType :: (A.KeyValue kv) => T.Text -> kv +theType :: (A.KeyValue kv) => T.Text -> kv theType :: Text -> kv -theType Text -t = Text +theType Text +t = Text "type" Text -> Text -> kv forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Text -t +t -instance A.ToJSON ServerMessage where - toJSON :: ServerMessage -> Value -toJSON (GQLConnectionError Maybe Value -e) +instance A.ToJSON ServerMessage where + toJSON :: ServerMessage -> Value +toJSON (GQLConnectionError Maybe Value +e) = [Pair] -> Value A.object [Text -> Pair forall kv. KeyValue kv => Text -> kv @@ -568,7 +568,7 @@ forall kv. KeyValue kv => Text -> kv "payload" Text -> Maybe Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Maybe Value -e] +e] toJSON ServerMessage GQLConnectionAck = [Pair] -> Value @@ -576,9 +576,9 @@ forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv forall kv. KeyValue kv => Text -> kv theType Text "connection_ack"] - toJSON (GQLData Text -i Value -p) + toJSON (GQLData Text +i Value +p) = [Pair] -> Value A.object [Text -> Pair forall kv. KeyValue kv => Text -> kv @@ -587,14 +587,14 @@ forall kv. KeyValue kv => Text -> kv "id" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Text -i, Text +i, Text "payload" Text -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Value -p] - toJSON (GQLError Text -i Value -p) +p] + toJSON (GQLError Text +i Value +p) = [Pair] -> Value A.object [Text -> Pair forall kv. KeyValue kv => Text -> kv @@ -603,13 +603,13 @@ forall kv. KeyValue kv => Text -> kv "id" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Text -i, Text +i, Text "payload" Text -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Value -p] - toJSON (GQLComplete Text -i) +p] + toJSON (GQLComplete Text +i) = [Pair] -> Value A.object [Text -> Pair forall kv. KeyValue kv => Text -> kv @@ -618,7 +618,7 @@ forall kv. KeyValue kv => Text -> kv "id" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Text -i] +i] toJSON ServerMessage GQLKeepAlive = [Pair] -> Value diff --git a/wip/haddock/mu-grpc-client/mu-grpc-client.haddock b/wip/haddock/mu-grpc-client/mu-grpc-client.haddock index d14e353..b45b0b0 100644 Binary files a/wip/haddock/mu-grpc-client/mu-grpc-client.haddock and b/wip/haddock/mu-grpc-client/mu-grpc-client.haddock differ diff --git a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Examples.html b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Examples.html index a33e3cf..a78b611 100644 --- a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Examples.html +++ b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Examples.html @@ -26,33 +26,33 @@ Look at the source code of this module. sayHello' :: HostName -> PortNumber -> T.Text -> IO (GRpcReply T.Text) sayHello' :: HostName -> PortNumber -> Text -> IO (GRpcReply Text) -sayHello' HostName -host PortNumber -port Text -req - = do Right GrpcClient -c <- GrpcClientConfig -> IO (Either ClientError GrpcClient) +sayHello' HostName +host PortNumber +port Text +req + = do Right GrpcClient +c <- GrpcClientConfig -> IO (Either ClientError GrpcClient) forall (m :: * -> *). MonadIO m => GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' (HostName -> PortNumber -> UseTlsOrNot -> GrpcClientConfig grpcClientConfigSimple HostName -host PortNumber -port UseTlsOrNot +host PortNumber +port UseTlsOrNot False) (HelloResponse -> Text) -> GRpcReply HelloResponse -> GRpcReply Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b -fmap (\(HelloResponse Text -r) -> Text -r) (GRpcReply HelloResponse -> GRpcReply Text) +fmap (\(HelloResponse Text +r) -> Text +r) (GRpcReply HelloResponse -> GRpcReply Text) -> IO (GRpcReply HelloResponse) -> IO (GRpcReply Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GrpcClient -> HelloRequest -> IO (GRpcReply HelloResponse) sayHello GrpcClient -c (Text -> HelloRequest +c (Text -> HelloRequest HelloRequest Text -req) +req) sayHello :: GrpcClient -> HelloRequest -> IO (GRpcReply HelloResponse) sayHello :: GrpcClient -> HelloRequest -> IO (GRpcReply HelloResponse) @@ -81,34 +81,34 @@ GrpcClient -> h sayHi' :: HostName -> PortNumber -> Int -> IO [GRpcReply T.Text] sayHi' :: HostName -> PortNumber -> Int -> IO [GRpcReply Text] -sayHi' HostName -host PortNumber -port Int -n - = do Right GrpcClient -c <- GrpcClientConfig -> IO (Either ClientError GrpcClient) +sayHi' HostName +host PortNumber +port Int +n + = do Right GrpcClient +c <- GrpcClientConfig -> IO (Either ClientError GrpcClient) forall (m :: * -> *). MonadIO m => GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' (HostName -> PortNumber -> UseTlsOrNot -> GrpcClientConfig grpcClientConfigSimple HostName -host PortNumber -port UseTlsOrNot +host PortNumber +port UseTlsOrNot False) - ConduitT () (GRpcReply HelloResponse) IO () -cndt <- GrpcClient + ConduitT () (GRpcReply HelloResponse) IO () +cndt <- GrpcClient -> HiRequest -> IO (ConduitT () (GRpcReply HelloResponse) IO ()) sayHi GrpcClient -c (Int -> HiRequest +c (Int -> HiRequest HiRequest Int -n) +n) ConduitT () Void IO [GRpcReply Text] -> IO [GRpcReply Text] forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r runConduit (ConduitT () Void IO [GRpcReply Text] -> IO [GRpcReply Text]) -> ConduitT () Void IO [GRpcReply Text] -> IO [GRpcReply Text] forall a b. (a -> b) -> a -> b $ ConduitT () (GRpcReply HelloResponse) IO () -cndt ConduitT () (GRpcReply HelloResponse) IO () +cndt ConduitT () (GRpcReply HelloResponse) IO () -> ConduitM (GRpcReply HelloResponse) Void IO [GRpcReply Text] -> ConduitT () Void IO [GRpcReply Text] forall (m :: * -> *) a b c r. @@ -120,9 +120,9 @@ forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m () C.map ((HelloResponse -> Text) -> GRpcReply HelloResponse -> GRpcReply Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b -fmap (\(HelloResponse Text -r) -> Text -r)) ConduitT (GRpcReply HelloResponse) (GRpcReply Text) IO () +fmap (\(HelloResponse Text +r) -> Text +r)) ConduitT (GRpcReply HelloResponse) (GRpcReply Text) IO () -> ConduitM (GRpcReply Text) Void IO [GRpcReply Text] -> ConduitM (GRpcReply HelloResponse) Void IO [GRpcReply Text] forall (m :: * -> *) a b c r. diff --git a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Internal.html b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Internal.html index f02df13..1ca7545 100644 --- a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Internal.html +++ b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Internal.html @@ -48,8 +48,8 @@ import Mu.Schema -- | Initialize a connection to a gRPC server. -setupGrpcClient' :: MonadIO m - => GrpcClientConfig -> m (Either ClientError GrpcClient) +setupGrpcClient' :: MonadIO m + => GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' :: GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' = IO (Either ClientError GrpcClient) -> m (Either ClientError GrpcClient) @@ -74,13 +74,13 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c -- | Initialize a connection to a gRPC server -- and pass information about distributed tracing. -setupGrpcClientZipkin - :: (MonadIO m, MonadTrace m) - => GrpcClientConfig -> T.Text -> m (Either ClientError GrpcClient) +setupGrpcClientZipkin + :: (MonadIO m, MonadTrace m) + => GrpcClientConfig -> T.Text -> m (Either ClientError GrpcClient) setupGrpcClientZipkin :: GrpcClientConfig -> Text -> m (Either ClientError GrpcClient) -setupGrpcClientZipkin GrpcClientConfig -cfg Text -spanName +setupGrpcClientZipkin GrpcClientConfig +cfg Text +spanName = Text -> (Maybe B3 -> m (Either ClientError GrpcClient)) -> m (Either ClientError GrpcClient) @@ -88,7 +88,7 @@ forall (m :: * -> *) a. MonadTrace m => Text -> (Maybe B3 -> m a) -> m a clientSpan Text -spanName ((Maybe B3 -> m (Either ClientError GrpcClient)) +spanName ((Maybe B3 -> m (Either ClientError GrpcClient)) -> m (Either ClientError GrpcClient)) -> (Maybe B3 -> m (Either ClientError GrpcClient)) -> m (Either ClientError GrpcClient) @@ -100,35 +100,35 @@ forall (m :: * -> *). MonadIO m => GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' GrpcClientConfig -cfg - (Just B3 -b3) -> GrpcClientConfig -> m (Either ClientError GrpcClient) +cfg + (Just B3 +b3) -> GrpcClientConfig -> m (Either ClientError GrpcClient) forall (m :: * -> *). MonadIO m => GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' GrpcClientConfig -cfg { +cfg { _grpcClientConfigHeaders :: [(ByteString, ByteString)] _grpcClientConfigHeaders = (ByteString "b3", B3 -> ByteString b3ToHeaderValue B3 -b3) +b3) (ByteString, ByteString) -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] forall a. a -> [a] -> [a] : GrpcClientConfig -> [(ByteString, ByteString)] _grpcClientConfigHeaders GrpcClientConfig -cfg +cfg } -class GRpcServiceMethodCall (p :: GRpcMessageProtocol) - (pkg :: snm) (s :: snm) - (m :: Method snm mnm anm (TypeRef snm)) h where - gRpcServiceMethodCall :: Proxy p -> Proxy pkg -> Proxy s -> Proxy m -> GrpcClient -> h -instance ( KnownName serviceName, KnownName pkg, KnownName mname - , GRpcMethodCall p ('Method mname margs mret) h, MkRPC p ) - => GRpcServiceMethodCall p pkg serviceName ('Method mname margs mret) h where - gRpcServiceMethodCall :: Proxy @GRpcMessageProtocol p +class GRpcServiceMethodCall (p :: GRpcMessageProtocol) + (pkg :: snm) (s :: snm) + (m :: Method snm mnm anm (TypeRef snm)) h where + gRpcServiceMethodCall :: Proxy p -> Proxy pkg -> Proxy s -> Proxy m -> GrpcClient -> h +instance ( KnownName serviceName, KnownName pkg, KnownName mname + , GRpcMethodCall p ('Method mname margs mret) h, MkRPC p ) + => GRpcServiceMethodCall p pkg serviceName ('Method mname margs mret) h where + gRpcServiceMethodCall :: Proxy @GRpcMessageProtocol p -> Proxy @Symbol pkg -> Proxy @Symbol serviceName -> Proxy @@ -137,8 +137,8 @@ forall a. a -> [a] -> [a] @* @Symbol @Symbol @Symbol @(TypeRef Symbol) mname margs mret) -> GrpcClient -> h -gRpcServiceMethodCall Proxy @GRpcMessageProtocol p -pro Proxy @Symbol pkg +gRpcServiceMethodCall Proxy @GRpcMessageProtocol p +pro Proxy @Symbol pkg _ Proxy @Symbol serviceName _ = RPCTy p -> Proxy @@ -154,55 +154,55 @@ RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) method -> GrpcClient -> h -gRpcMethodCall @p RPCTy p -rpc - where pkgName :: ByteString -pkgName = String -> ByteString +gRpcMethodCall @p RPCTy p +rpc + where pkgName :: ByteString +pkgName = String -> ByteString BS.pack (Proxy @Symbol pkg -> String forall k (a :: k) (proxy :: k -> *). KnownName @k a => proxy a -> String nameVal (Proxy @Symbol pkg forall k (t :: k). Proxy @k t -Proxy @pkg)) - svrName :: ByteString -svrName = String -> ByteString +Proxy @pkg)) + svrName :: ByteString +svrName = String -> ByteString BS.pack (Proxy @Symbol serviceName -> String forall k (a :: k) (proxy :: k -> *). KnownName @k a => proxy a -> String nameVal (Proxy @Symbol serviceName forall k (t :: k). Proxy @k t -Proxy @serviceName)) - metName :: ByteString -metName = String -> ByteString +Proxy @serviceName)) + metName :: ByteString +metName = String -> ByteString BS.pack (Proxy @Symbol mname -> String forall k (a :: k) (proxy :: k -> *). KnownName @k a => proxy a -> String nameVal (Proxy @Symbol mname forall k (t :: k). Proxy @k t -Proxy @mname)) - rpc :: RPCTy p -rpc = Proxy @GRpcMessageProtocol p +Proxy @mname)) + rpc :: RPCTy p +rpc = Proxy @GRpcMessageProtocol p -> ByteString -> ByteString -> ByteString -> RPCTy p forall (p :: GRpcMessageProtocol). MkRPC p => Proxy @GRpcMessageProtocol p -> ByteString -> ByteString -> ByteString -> RPCTy p mkRPC Proxy @GRpcMessageProtocol p -pro ByteString -pkgName ByteString -svrName ByteString -metName +pro ByteString +pkgName ByteString +svrName ByteString +metName -data GRpcReply a +data GRpcReply a = GRpcTooMuchConcurrency TooMuchConcurrency | GRpcErrorCode ErrorCode | GRpcErrorString String | GRpcClientError ClientError - | GRpcOk a - deriving (Int -> GRpcReply a -> ShowS + | GRpcOk a + deriving (Int -> GRpcReply a -> ShowS [GRpcReply a] -> ShowS GRpcReply a -> String (Int -> GRpcReply a -> ShowS) @@ -220,7 +220,7 @@ show :: GRpcReply a -> String $cshow :: forall a. Show a => GRpcReply a -> String showsPrec :: Int -> GRpcReply a -> ShowS $cshowsPrec :: forall a. Show a => Int -> GRpcReply a -> ShowS -Show, a -> GRpcReply b -> GRpcReply a +Show, a -> GRpcReply b -> GRpcReply a (a -> b) -> GRpcReply a -> GRpcReply b (forall a b. (a -> b) -> GRpcReply a -> GRpcReply b) -> (forall a b. a -> GRpcReply b -> GRpcReply a) @@ -236,134 +236,134 @@ fmap :: (a -> b) -> GRpcReply a -> GRpcReply b $cfmap :: forall a b. (a -> b) -> GRpcReply a -> GRpcReply b Functor) -buildGRpcReply1 :: Either TooMuchConcurrency (RawReply a) -> GRpcReply a +buildGRpcReply1 :: Either TooMuchConcurrency (RawReply a) -> GRpcReply a buildGRpcReply1 :: Either TooMuchConcurrency (RawReply a) -> GRpcReply a -buildGRpcReply1 (Left TooMuchConcurrency -tmc) = TooMuchConcurrency -> GRpcReply a +buildGRpcReply1 (Left TooMuchConcurrency +tmc) = TooMuchConcurrency -> GRpcReply a forall a. TooMuchConcurrency -> GRpcReply a GRpcTooMuchConcurrency TooMuchConcurrency -tmc -buildGRpcReply1 (Right (Left ErrorCode -ec)) = ErrorCode -> GRpcReply a +tmc +buildGRpcReply1 (Right (Left ErrorCode +ec)) = ErrorCode -> GRpcReply a forall a. ErrorCode -> GRpcReply a GRpcErrorCode ErrorCode -ec +ec buildGRpcReply1 (Right (Right (CIHeaderList _, Maybe CIHeaderList -_, Left String -es))) = String -> GRpcReply a +_, Left String +es))) = String -> GRpcReply a forall a. String -> GRpcReply a GRpcErrorString String -es +es buildGRpcReply1 (Right (Right (CIHeaderList _, Maybe CIHeaderList -_, Right a -r))) = a -> GRpcReply a +_, Right a +r))) = a -> GRpcReply a forall a. a -> GRpcReply a GRpcOk a -r +r -buildGRpcReply2 :: Either TooMuchConcurrency (r, RawReply a) -> GRpcReply a +buildGRpcReply2 :: Either TooMuchConcurrency (r, RawReply a) -> GRpcReply a buildGRpcReply2 :: Either TooMuchConcurrency (r, RawReply a) -> GRpcReply a -buildGRpcReply2 (Left TooMuchConcurrency -tmc) = TooMuchConcurrency -> GRpcReply a +buildGRpcReply2 (Left TooMuchConcurrency +tmc) = TooMuchConcurrency -> GRpcReply a forall a. TooMuchConcurrency -> GRpcReply a GRpcTooMuchConcurrency TooMuchConcurrency -tmc +tmc buildGRpcReply2 (Right (r -_, Left ErrorCode -ec)) = ErrorCode -> GRpcReply a +_, Left ErrorCode +ec)) = ErrorCode -> GRpcReply a forall a. ErrorCode -> GRpcReply a GRpcErrorCode ErrorCode -ec +ec buildGRpcReply2 (Right (r _, Right (CIHeaderList _, Maybe CIHeaderList -_, Left String -es))) = String -> GRpcReply a +_, Left String +es))) = String -> GRpcReply a forall a. String -> GRpcReply a GRpcErrorString String -es +es buildGRpcReply2 (Right (r _, Right (CIHeaderList _, Maybe CIHeaderList -_, Right a -r))) = a -> GRpcReply a +_, Right a +r))) = a -> GRpcReply a forall a. a -> GRpcReply a GRpcOk a -r +r -buildGRpcReply3 :: Either TooMuchConcurrency v -> GRpcReply () +buildGRpcReply3 :: Either TooMuchConcurrency v -> GRpcReply () buildGRpcReply3 :: Either TooMuchConcurrency v -> GRpcReply () -buildGRpcReply3 (Left TooMuchConcurrency -tmc) = TooMuchConcurrency -> GRpcReply () +buildGRpcReply3 (Left TooMuchConcurrency +tmc) = TooMuchConcurrency -> GRpcReply () forall a. TooMuchConcurrency -> GRpcReply a GRpcTooMuchConcurrency TooMuchConcurrency -tmc +tmc buildGRpcReply3 (Right v _) = () -> GRpcReply () forall a. a -> GRpcReply a GRpcOk () -simplifyResponse :: ClientIO (GRpcReply a) -> IO (GRpcReply a) +simplifyResponse :: ClientIO (GRpcReply a) -> IO (GRpcReply a) simplifyResponse :: ClientIO (GRpcReply a) -> IO (GRpcReply a) -simplifyResponse ClientIO (GRpcReply a) -reply = do - Either ClientError (GRpcReply a) -r <- ClientIO (GRpcReply a) -> IO (Either ClientError (GRpcReply a)) +simplifyResponse ClientIO (GRpcReply a) +reply = do + Either ClientError (GRpcReply a) +r <- ClientIO (GRpcReply a) -> IO (Either ClientError (GRpcReply a)) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT ClientIO (GRpcReply a) -reply +reply GRpcReply a -> IO (GRpcReply a) forall (f :: * -> *) a. Applicative f => a -> f a pure (GRpcReply a -> IO (GRpcReply a)) -> GRpcReply a -> IO (GRpcReply a) forall a b. (a -> b) -> a -> b $ case Either ClientError (GRpcReply a) -r of - Left ClientError -e -> ClientError -> GRpcReply a +r of + Left ClientError +e -> ClientError -> GRpcReply a forall a. ClientError -> GRpcReply a GRpcClientError ClientError -e - Right GRpcReply a -v -> GRpcReply a -v +e + Right GRpcReply a +v -> GRpcReply a +v -- These type classes allow us to abstract over -- the choice of message protocol (PB or Avro) -class GRPCInput (RPCTy p) (GRpcIWTy p ref r) - => GRpcInputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where - type GRpcIWTy p ref r :: Type - buildGRpcIWTy :: Proxy p -> Proxy ref -> r -> GRpcIWTy p ref r +class GRPCInput (RPCTy p) (GRpcIWTy p ref r) + => GRpcInputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where + type GRpcIWTy p ref r :: Type + buildGRpcIWTy :: Proxy p -> Proxy ref -> r -> GRpcIWTy p ref r -instance ToProtoBufTypeRef ref r - => GRpcInputWrapper 'MsgProtoBuf ref r where - type GRpcIWTy 'MsgProtoBuf ref r = ViaToProtoBufTypeRef ref r - buildGRpcIWTy :: Proxy @GRpcMessageProtocol 'MsgProtoBuf +instance ToProtoBufTypeRef ref r + => GRpcInputWrapper 'MsgProtoBuf ref r where + type GRpcIWTy 'MsgProtoBuf ref r = ViaToProtoBufTypeRef ref r + buildGRpcIWTy :: Proxy @GRpcMessageProtocol 'MsgProtoBuf -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm 'MsgProtoBuf ref r -buildGRpcIWTy Proxy @GRpcMessageProtocol 'MsgProtoBuf +buildGRpcIWTy Proxy @GRpcMessageProtocol 'MsgProtoBuf _ Proxy @(TypeRef snm) ref _ = r -> GRpcIWTy @snm 'MsgProtoBuf ref r forall snm (ref :: TypeRef snm) t. t -> ViaToProtoBufTypeRef @snm ref t ViaToProtoBufTypeRef -instance forall (sch :: Schema') (sty :: Symbol) (r :: Type). - ( ToSchema sch sty r - , ToAvro (WithSchema sch sty r) - , HasAvroSchema (WithSchema sch sty r) ) - => GRpcInputWrapper 'MsgAvro ('SchemaRef sch sty) r where - type GRpcIWTy 'MsgAvro ('SchemaRef sch sty) r = ViaToAvroTypeRef ('SchemaRef sch sty) r - buildGRpcIWTy :: Proxy @GRpcMessageProtocol 'MsgAvro +instance forall (sch :: Schema') (sty :: Symbol) (r :: Type). + ( ToSchema sch sty r + , ToAvro (WithSchema sch sty r) + , HasAvroSchema (WithSchema sch sty r) ) + => GRpcInputWrapper 'MsgAvro ('SchemaRef sch sty) r where + type GRpcIWTy 'MsgAvro ('SchemaRef sch sty) r = ViaToAvroTypeRef ('SchemaRef sch sty) r + buildGRpcIWTy :: Proxy @GRpcMessageProtocol 'MsgAvro -> Proxy @(TypeRef snm) ('SchemaRef @Symbol @Symbol @snm sch sty) -> r -> GRpcIWTy @snm 'MsgAvro ('SchemaRef @Symbol @Symbol @snm sch sty) r -buildGRpcIWTy Proxy @GRpcMessageProtocol 'MsgAvro +buildGRpcIWTy Proxy @GRpcMessageProtocol 'MsgAvro _ Proxy @(TypeRef snm) ('SchemaRef @Symbol @Symbol @snm sch sty) _ = r -> GRpcIWTy @@ -371,37 +371,37 @@ t -> ViaToProtoBufTypeRef @snm ref t forall snm (ref :: TypeRef snm) t. t -> ViaToAvroTypeRef @snm ref t ViaToAvroTypeRef -class GRPCOutput (RPCTy p) (GRpcOWTy p ref r) - => GRpcOutputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where - type GRpcOWTy p ref r :: Type - unGRpcOWTy :: Proxy p -> Proxy ref -> GRpcOWTy p ref r -> r +class GRPCOutput (RPCTy p) (GRpcOWTy p ref r) + => GRpcOutputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where + type GRpcOWTy p ref r :: Type + unGRpcOWTy :: Proxy p -> Proxy ref -> GRpcOWTy p ref r -> r -instance FromProtoBufTypeRef ref r - => GRpcOutputWrapper 'MsgProtoBuf ref r where - type GRpcOWTy 'MsgProtoBuf ref r = ViaFromProtoBufTypeRef ref r - unGRpcOWTy :: Proxy @GRpcMessageProtocol 'MsgProtoBuf +instance FromProtoBufTypeRef ref r + => GRpcOutputWrapper 'MsgProtoBuf ref r where + type GRpcOWTy 'MsgProtoBuf ref r = ViaFromProtoBufTypeRef ref r + unGRpcOWTy :: Proxy @GRpcMessageProtocol 'MsgProtoBuf -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm 'MsgProtoBuf ref r -> r -unGRpcOWTy Proxy @GRpcMessageProtocol 'MsgProtoBuf +unGRpcOWTy Proxy @GRpcMessageProtocol 'MsgProtoBuf _ Proxy @(TypeRef snm) ref _ = GRpcOWTy @snm 'MsgProtoBuf ref r -> r forall snm (ref :: TypeRef snm) t. ViaFromProtoBufTypeRef @snm ref t -> t unViaFromProtoBufTypeRef -instance forall (sch :: Schema') (sty :: Symbol) (r :: Type). - ( FromSchema sch sty r - , FromAvro (WithSchema sch sty r) - , HasAvroSchema (WithSchema sch sty r) ) - => GRpcOutputWrapper 'MsgAvro ('SchemaRef sch sty) r where - type GRpcOWTy 'MsgAvro ('SchemaRef sch sty) r = ViaFromAvroTypeRef ('SchemaRef sch sty) r - unGRpcOWTy :: Proxy @GRpcMessageProtocol 'MsgAvro +instance forall (sch :: Schema') (sty :: Symbol) (r :: Type). + ( FromSchema sch sty r + , FromAvro (WithSchema sch sty r) + , HasAvroSchema (WithSchema sch sty r) ) + => GRpcOutputWrapper 'MsgAvro ('SchemaRef sch sty) r where + type GRpcOWTy 'MsgAvro ('SchemaRef sch sty) r = ViaFromAvroTypeRef ('SchemaRef sch sty) r + unGRpcOWTy :: Proxy @GRpcMessageProtocol 'MsgAvro -> Proxy @(TypeRef snm) ('SchemaRef @Symbol @Symbol @snm sch sty) -> GRpcOWTy @snm 'MsgAvro ('SchemaRef @Symbol @Symbol @snm sch sty) r -> r -unGRpcOWTy Proxy @GRpcMessageProtocol 'MsgAvro +unGRpcOWTy Proxy @GRpcMessageProtocol 'MsgAvro _ Proxy @(TypeRef snm) ('SchemaRef @Symbol @Symbol @snm sch sty) _ = GRpcOWTy @snm 'MsgAvro ('SchemaRef @Symbol @Symbol @snm sch sty) r -> r @@ -413,14 +413,14 @@ ViaFromAvroTypeRef @snm ref t -> t -- IMPLEMENTATION OF THE METHODS -- ----------------------------- -class GRpcMethodCall (p :: GRpcMessageProtocol) (method :: Method') h where - gRpcMethodCall :: RPCTy p -> Proxy method -> GrpcClient -> h +class GRpcMethodCall (p :: GRpcMessageProtocol) (method :: Method') h where + gRpcMethodCall :: RPCTy p -> Proxy method -> GrpcClient -> h -instance ( KnownName name - , GRPCInput (RPCTy p) (), GRPCOutput (RPCTy p) () - , handler ~ IO (GRpcReply ()) ) - => GRpcMethodCall p ('Method name '[ ] 'RetNothing) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRPCInput (RPCTy p) (), GRPCOutput (RPCTy p) () + , handler ~ IO (GRpcReply ()) ) + => GRpcMethodCall p ('Method name '[ ] 'RetNothing) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -434,8 +434,8 @@ ViaFromAvroTypeRef @snm ref t -> t ('RetNothing @* @Symbol @(TypeRef Symbol))) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -446,8 +446,8 @@ ViaFromAvroTypeRef @snm ref t -> t name ('[] @(Argument @* Symbol Symbol (TypeRef Symbol))) ('RetNothing @* @Symbol @(TypeRef Symbol))) -_ GrpcClient -client +_ GrpcClient +client = ClientIO (GRpcReply ()) -> IO (GRpcReply ()) forall a. ClientIO (GRpcReply a) -> IO (GRpcReply a) simplifyResponse (ClientIO (GRpcReply ()) -> IO (GRpcReply ())) @@ -472,14 +472,14 @@ r -> i -> ClientIO (Either TooMuchConcurrency (RawReply o)) rawUnary RPCTy p -rpc GrpcClient -client () +rpc GrpcClient +client () -instance ( KnownName name - , GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r - , handler ~ IO (GRpcReply r) ) - => GRpcMethodCall p ('Method name '[ ] ('RetSingle rref)) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r + , handler ~ IO (GRpcReply r) ) + => GRpcMethodCall p ('Method name '[ ] ('RetSingle rref)) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -493,8 +493,8 @@ r ('RetSingle @* @(TypeRef Symbol) @Symbol rref)) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -505,8 +505,8 @@ r name ('[] @(Argument @* Symbol Symbol (TypeRef Symbol))) ('RetSingle @* @(TypeRef Symbol) @Symbol rref)) -_ GrpcClient -client +_ GrpcClient +client = (GRpcReply (GRpcOWTy @Symbol p rref r) -> GRpcReply r) -> IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -521,9 +521,9 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm p ref r -> r unGRpcOWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) rref +Proxy @p) (Proxy @(TypeRef Symbol) rref forall k (t :: k). Proxy @k t -Proxy @rref))) (IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r)) +Proxy @rref))) (IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r)) -> IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r) forall a b. (a -> b) -> a -> b $ @@ -561,15 +561,15 @@ r -> GrpcClient -> i -> ClientIO (Either TooMuchConcurrency (RawReply o)) -rawUnary @_ @() @(GRpcOWTy p rref r) RPCTy p -rpc GrpcClient -client () +rawUnary @_ @() @(GRpcOWTy p rref r) RPCTy p +rpc GrpcClient +client () -instance ( KnownName name - , GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r - , handler ~ IO (ConduitT () (GRpcReply r) IO ()) ) - => GRpcMethodCall p ('Method name '[ ] ('RetStream rref)) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r + , handler ~ IO (ConduitT () (GRpcReply r) IO ()) ) + => GRpcMethodCall p ('Method name '[ ] ('RetStream rref)) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -583,8 +583,8 @@ r ('RetStream @* @(TypeRef Symbol) @Symbol rref)) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -595,15 +595,15 @@ r name ('[] @(Argument @* Symbol Symbol (TypeRef Symbol))) ('RetStream @* @(TypeRef Symbol) @Symbol rref)) -_ GrpcClient -client +_ GrpcClient +client = do -- Create a new TMChan - TMChan r -chan <- IO (TMChan r) + TMChan r +chan <- IO (TMChan r) forall a. IO (TMChan a) -newTMChanIO :: IO (TMChan r) - TMVar (GRpcReply ()) -var <- IO (TMVar (GRpcReply ())) +newTMChanIO :: IO (TMChan r) + TMVar (GRpcReply ()) +var <- IO (TMVar (GRpcReply ())) forall a. IO (TMVar a) newEmptyTMVarIO -- if full, this means an error -- Start executing the client in another thread @@ -613,8 +613,8 @@ forall a. IO a -> IO (Async a) async (IO () -> IO (Async ())) -> IO () -> IO (Async ()) forall a b. (a -> b) -> a -> b $ do - GRpcReply () -v <- ClientIO (GRpcReply ()) -> IO (GRpcReply ()) + GRpcReply () +v <- ClientIO (GRpcReply ()) -> IO (GRpcReply ()) forall a. ClientIO (GRpcReply a) -> IO (GRpcReply a) simplifyResponse (ClientIO (GRpcReply ()) -> IO (GRpcReply ())) -> ClientIO (GRpcReply ()) -> IO (GRpcReply ()) @@ -663,14 +663,14 @@ r (Either TooMuchConcurrency (a, [(ByteString, ByteString)], [(ByteString, ByteString)])) -rawStreamServer @_ @() @(GRpcOWTy p rref r) +rawStreamServer @_ @() @(GRpcOWTy p rref r) RPCTy p -rpc GrpcClient -client () () +rpc GrpcClient +client () () (\() _ [(ByteString, ByteString)] -_ GRpcOWTy @Symbol p rref r -newVal -> IO () -> ClientIO () +_ GRpcOWTy @Symbol p rref r +newVal -> IO () -> ClientIO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ClientIO ()) -> IO () -> ClientIO () forall a b. (a -> b) -> a -> b @@ -684,13 +684,13 @@ forall a b. (a -> b) -> a -> b _ <- TMVar (GRpcReply ()) -> GRpcReply () -> STM Bool forall a. TMVar a -> a -> STM Bool tryPutTMVar TMVar (GRpcReply ()) -var (() -> GRpcReply () +var (() -> GRpcReply () forall a. a -> GRpcReply a GRpcOk ()) TMChan r -> r -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan r -chan (Proxy @GRpcMessageProtocol p +chan (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) rref -> GRpcOWTy @Symbol p rref r -> r forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcOutputWrapper @snm p ref r => @@ -698,12 +698,12 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm p ref r -> r unGRpcOWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) rref +Proxy @p) (Proxy @(TypeRef Symbol) rref forall k (t :: k). Proxy @k t -Proxy @rref) GRpcOWTy @Symbol p rref r -newVal)) +Proxy @rref) GRpcOWTy @Symbol p rref r +newVal)) case GRpcReply () -v of +v of GRpcOk () -> IO () -> IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> IO ()) -> IO () -> IO () @@ -715,7 +715,7 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> STM () forall a. TMChan a -> STM () closeTMChan TMChan r -chan +chan GRpcReply () _ -> IO () -> IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -728,12 +728,12 @@ forall a b. (a -> b) -> a -> b $ TMVar (GRpcReply ()) -> GRpcReply () -> STM () forall a. TMVar a -> a -> STM () putTMVar TMVar (GRpcReply ()) -var GRpcReply () -v +var GRpcReply () +v -- This conduit feeds information to the other thread - let go :: ConduitT () (GRpcReply r) IO () -go = do GRpcReply () -firstResult <- IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ()) + let go :: ConduitT () (GRpcReply r) IO () +go = do GRpcReply () +firstResult <- IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ())) -> IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ()) @@ -746,15 +746,15 @@ forall a b. (a -> b) -> a -> b $ TMVar (GRpcReply ()) -> STM (GRpcReply ()) forall a. TMVar a -> STM a takeTMVar TMVar (GRpcReply ()) -var +var case GRpcReply () -firstResult of +firstResult of GRpcOk () _ -> -- no error, everything is fine TMChan r -> ConduitT () r IO () forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m () sourceTMChan TMChan r -chan ConduitT () r IO () +chan ConduitT () r IO () -> ConduitM r (GRpcReply r) IO () -> ConduitT () (GRpcReply r) IO () forall (m :: * -> *) a b c r. @@ -765,8 +765,8 @@ forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m () C.map r -> GRpcReply r forall a. a -> GRpcReply a GRpcOk - GRpcReply () -e -> GRpcReply r -> ConduitT () (GRpcReply r) IO () + GRpcReply () +e -> GRpcReply r -> ConduitT () (GRpcReply r) IO () forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m () yield (GRpcReply r -> ConduitT () (GRpcReply r) IO ()) -> GRpcReply r -> ConduitT () (GRpcReply r) IO () @@ -778,19 +778,19 @@ forall a. HasCallStack => String -> a "this should never happen") (() -> r) -> GRpcReply () -> GRpcReply r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GRpcReply () -e +e ConduitT () (GRpcReply r) IO () -> IO (ConduitT () (GRpcReply r) IO ()) forall (f :: * -> *) a. Applicative f => a -> f a pure ConduitT () (GRpcReply r) IO () -go +go -instance ( KnownName name - , GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) () - , handler ~ (v -> IO (GRpcReply ())) ) - => GRpcMethodCall p ('Method name '[ 'ArgSingle aname vref ] - 'RetNothing) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) () + , handler ~ (v -> IO (GRpcReply ())) ) + => GRpcMethodCall p ('Method name '[ 'ArgSingle aname vref ] + 'RetNothing) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -807,8 +807,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a ('RetNothing @* @Symbol @(TypeRef Symbol))) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -822,9 +822,9 @@ forall (f :: * -> *) a. Applicative f => a -> f a ('ArgSingle @* @Symbol @(TypeRef Symbol) @Symbol aname vref) ('[] @(Argument @* Symbol Symbol (TypeRef Symbol)))) ('RetNothing @* @Symbol @(TypeRef Symbol))) -_ GrpcClient -client v -x +_ GrpcClient +client v +x = ClientIO (GRpcReply ()) -> IO (GRpcReply ()) forall a. ClientIO (GRpcReply a) -> IO (GRpcReply a) simplifyResponse (ClientIO (GRpcReply ()) -> IO (GRpcReply ())) @@ -848,9 +848,9 @@ r -> GrpcClient -> i -> ClientIO (Either TooMuchConcurrency (RawReply o)) -rawUnary @_ @(GRpcIWTy p vref v) @() RPCTy p -rpc GrpcClient -client (Proxy @GRpcMessageProtocol p +rawUnary @_ @(GRpcIWTy p vref v) @() RPCTy p +rpc GrpcClient +client (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) vref -> v -> GRpcIWTy @Symbol p vref v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper @snm p ref r => @@ -858,17 +858,17 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm p ref r buildGRpcIWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) vref +Proxy @p) (Proxy @(TypeRef Symbol) vref forall k (t :: k). Proxy @k t -Proxy @vref) v -x) +Proxy @vref) v +x) -instance ( KnownName name - , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r - , handler ~ (v -> IO (GRpcReply r)) ) - => GRpcMethodCall p ('Method name '[ 'ArgSingle aname vref ] - ('RetSingle rref)) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r + , handler ~ (v -> IO (GRpcReply r)) ) + => GRpcMethodCall p ('Method name '[ 'ArgSingle aname vref ] + ('RetSingle rref)) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -885,8 +885,8 @@ forall k (t :: k). Proxy @k t ('RetSingle @* @(TypeRef Symbol) @Symbol rref)) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -900,9 +900,9 @@ forall k (t :: k). Proxy @k t ('ArgSingle @* @Symbol @(TypeRef Symbol) @Symbol aname vref) ('[] @(Argument @* Symbol Symbol (TypeRef Symbol)))) ('RetSingle @* @(TypeRef Symbol) @Symbol rref)) -_ GrpcClient -client v -x +_ GrpcClient +client v +x = (GRpcReply (GRpcOWTy @Symbol p rref r) -> GRpcReply r) -> IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b @@ -917,9 +917,9 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm p ref r -> r unGRpcOWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) rref +Proxy @p) (Proxy @(TypeRef Symbol) rref forall k (t :: k). Proxy @k t -Proxy @rref))) (IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r)) +Proxy @rref))) (IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r)) -> IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r) forall a b. (a -> b) -> a -> b $ @@ -957,10 +957,10 @@ r -> GrpcClient -> i -> ClientIO (Either TooMuchConcurrency (RawReply o)) -rawUnary @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) +rawUnary @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) RPCTy p -rpc GrpcClient -client (Proxy @GRpcMessageProtocol p +rpc GrpcClient +client (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) vref -> v -> GRpcIWTy @Symbol p vref v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper @snm p ref r => @@ -968,17 +968,17 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm p ref r buildGRpcIWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) vref +Proxy @p) (Proxy @(TypeRef Symbol) vref forall k (t :: k). Proxy @k t -Proxy @vref) v -x) +Proxy @vref) v +x) -instance ( KnownName name - , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r - , handler ~ (v -> IO (ConduitT () (GRpcReply r) IO ())) ) - => GRpcMethodCall p ('Method name '[ 'ArgSingle aname vref ] - ('RetStream rref)) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r + , handler ~ (v -> IO (ConduitT () (GRpcReply r) IO ())) ) + => GRpcMethodCall p ('Method name '[ 'ArgSingle aname vref ] + ('RetStream rref)) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -995,8 +995,8 @@ forall k (t :: k). Proxy @k t ('RetStream @* @(TypeRef Symbol) @Symbol rref)) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -1010,16 +1010,16 @@ forall k (t :: k). Proxy @k t ('ArgSingle @* @Symbol @(TypeRef Symbol) @Symbol aname vref) ('[] @(Argument @* Symbol Symbol (TypeRef Symbol)))) ('RetStream @* @(TypeRef Symbol) @Symbol rref)) -_ GrpcClient -client v -x +_ GrpcClient +client v +x = do -- Create a new TMChan - TMChan r -chan <- IO (TMChan r) + TMChan r +chan <- IO (TMChan r) forall a. IO (TMChan a) -newTMChanIO :: IO (TMChan r) - TMVar (GRpcReply ()) -var <- IO (TMVar (GRpcReply ())) +newTMChanIO :: IO (TMChan r) + TMVar (GRpcReply ()) +var <- IO (TMVar (GRpcReply ())) forall a. IO (TMVar a) newEmptyTMVarIO -- if full, this means an error -- Start executing the client in another thread @@ -1029,8 +1029,8 @@ forall a. IO a -> IO (Async a) async (IO () -> IO (Async ())) -> IO () -> IO (Async ()) forall a b. (a -> b) -> a -> b $ do - GRpcReply () -v <- ClientIO (GRpcReply ()) -> IO (GRpcReply ()) + GRpcReply () +v <- ClientIO (GRpcReply ()) -> IO (GRpcReply ()) forall a. ClientIO (GRpcReply a) -> IO (GRpcReply a) simplifyResponse (ClientIO (GRpcReply ()) -> IO (GRpcReply ())) -> ClientIO (GRpcReply ()) -> IO (GRpcReply ()) @@ -1079,10 +1079,10 @@ r (Either TooMuchConcurrency (a, [(ByteString, ByteString)], [(ByteString, ByteString)])) -rawStreamServer @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) +rawStreamServer @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) RPCTy p -rpc GrpcClient -client () (Proxy @GRpcMessageProtocol p +rpc GrpcClient +client () (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) vref -> v -> GRpcIWTy @Symbol p vref v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper @snm p ref r => @@ -1090,14 +1090,14 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm p ref r buildGRpcIWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) vref +Proxy @p) (Proxy @(TypeRef Symbol) vref forall k (t :: k). Proxy @k t -Proxy @vref) v -x) +Proxy @vref) v +x) (\() _ [(ByteString, ByteString)] -_ GRpcOWTy @Symbol p rref r -newVal -> IO () -> ClientIO () +_ GRpcOWTy @Symbol p rref r +newVal -> IO () -> ClientIO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ClientIO ()) -> IO () -> ClientIO () forall a b. (a -> b) -> a -> b @@ -1111,13 +1111,13 @@ forall a b. (a -> b) -> a -> b _ <- TMVar (GRpcReply ()) -> GRpcReply () -> STM Bool forall a. TMVar a -> a -> STM Bool tryPutTMVar TMVar (GRpcReply ()) -var (() -> GRpcReply () +var (() -> GRpcReply () forall a. a -> GRpcReply a GRpcOk ()) TMChan r -> r -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan r -chan (Proxy @GRpcMessageProtocol p +chan (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) rref -> GRpcOWTy @Symbol p rref r -> r forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcOutputWrapper @snm p ref r => @@ -1125,12 +1125,12 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm p ref r -> r unGRpcOWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) rref +Proxy @p) (Proxy @(TypeRef Symbol) rref forall k (t :: k). Proxy @k t -Proxy @rref) GRpcOWTy @Symbol p rref r -newVal)) +Proxy @rref) GRpcOWTy @Symbol p rref r +newVal)) case GRpcReply () -v of +v of GRpcOk () -> IO () -> IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> IO ()) -> IO () -> IO () @@ -1142,7 +1142,7 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> STM () forall a. TMChan a -> STM () closeTMChan TMChan r -chan +chan GRpcReply () _ -> IO () -> IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1155,12 +1155,12 @@ forall a b. (a -> b) -> a -> b $ TMVar (GRpcReply ()) -> GRpcReply () -> STM () forall a. TMVar a -> a -> STM () putTMVar TMVar (GRpcReply ()) -var GRpcReply () -v +var GRpcReply () +v -- This conduit feeds information to the other thread - let go :: ConduitT () (GRpcReply r) IO () -go = do GRpcReply () -firstResult <- IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ()) + let go :: ConduitT () (GRpcReply r) IO () +go = do GRpcReply () +firstResult <- IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ())) -> IO (GRpcReply ()) -> ConduitT () (GRpcReply r) IO (GRpcReply ()) @@ -1173,15 +1173,15 @@ forall a b. (a -> b) -> a -> b $ TMVar (GRpcReply ()) -> STM (GRpcReply ()) forall a. TMVar a -> STM a takeTMVar TMVar (GRpcReply ()) -var +var case GRpcReply () -firstResult of +firstResult of GRpcOk () _ -> -- no error, everything is fine TMChan r -> ConduitT () r IO () forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m () sourceTMChan TMChan r -chan ConduitT () r IO () +chan ConduitT () r IO () -> ConduitM r (GRpcReply r) IO () -> ConduitT () (GRpcReply r) IO () forall (m :: * -> *) a b c r. @@ -1192,8 +1192,8 @@ forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m () C.map r -> GRpcReply r forall a. a -> GRpcReply a GRpcOk - GRpcReply () -e -> GRpcReply r -> ConduitT () (GRpcReply r) IO () + GRpcReply () +e -> GRpcReply r -> ConduitT () (GRpcReply r) IO () forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m () yield (GRpcReply r -> ConduitT () (GRpcReply r) IO ()) -> GRpcReply r -> ConduitT () (GRpcReply r) IO () @@ -1205,19 +1205,19 @@ forall a. HasCallStack => String -> a "this should never happen") (() -> r) -> GRpcReply () -> GRpcReply r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GRpcReply () -e +e ConduitT () (GRpcReply r) IO () -> IO (ConduitT () (GRpcReply r) IO ()) forall (f :: * -> *) a. Applicative f => a -> f a pure ConduitT () (GRpcReply r) IO () -go +go -instance ( KnownName name - , GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) () - , handler ~ (CompressMode -> IO (ConduitT v Void IO (GRpcReply ()))) ) - => GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ] - 'RetNothing) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) () + , handler ~ (CompressMode -> IO (ConduitT v Void IO (GRpcReply ()))) ) + => GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ] + 'RetNothing) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -1234,8 +1234,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a ('RetNothing @* @Symbol @(TypeRef Symbol))) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -1249,17 +1249,17 @@ forall (f :: * -> *) a. Applicative f => a -> f a ('ArgStream @* @Symbol @(TypeRef Symbol) @Symbol aname vref) ('[] @(Argument @* Symbol Symbol (TypeRef Symbol)))) ('RetNothing @* @Symbol @(TypeRef Symbol))) -_ GrpcClient -client CompressMode -compress +_ GrpcClient +client CompressMode +compress = do -- Create a new TMChan - TMChan v -chan <- IO (TMChan v) + TMChan v +chan <- IO (TMChan v) forall a. IO (TMChan a) -newTMChanIO :: IO (TMChan v) +newTMChanIO :: IO (TMChan v) -- Start executing the client in another thread - Async (GRpcReply ()) -promise <- IO (GRpcReply ()) -> IO (Async (GRpcReply ())) + Async (GRpcReply ()) +promise <- IO (GRpcReply ()) -> IO (Async (GRpcReply ())) forall a. IO a -> IO (Async a) async (IO (GRpcReply ()) -> IO (Async (GRpcReply ()))) -> IO (GRpcReply ()) -> IO (Async (GRpcReply ())) @@ -1295,12 +1295,12 @@ r -> a -> (a -> ClientIO (a, Either StreamDone (CompressMode, i))) -> ClientIO (Either TooMuchConcurrency (a, RawReply o)) -rawStreamClient @_ @(GRpcIWTy p vref v) @() RPCTy p -rpc GrpcClient -client () +rawStreamClient @_ @(GRpcIWTy p vref v) @() RPCTy p +rpc GrpcClient +client () (\() -_ -> do Maybe v -nextVal <- IO (Maybe v) -> ExceptT ClientError IO (Maybe v) +_ -> do Maybe v +nextVal <- IO (Maybe v) -> ExceptT ClientError IO (Maybe v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe v) -> ExceptT ClientError IO (Maybe v)) -> IO (Maybe v) -> ExceptT ClientError IO (Maybe v) @@ -1312,9 +1312,9 @@ forall a b. (a -> b) -> a -> b $ TMChan v -> STM (Maybe v) forall a. TMChan a -> STM (Maybe a) readTMChan TMChan v -chan +chan case Maybe v -nextVal of +nextVal of Maybe v Nothing -> ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) -> ClientIO @@ -1325,8 +1325,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a b. a -> Either a b Left StreamDone StreamDone) - Just v -v -> ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) + Just v +v -> ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) -> ClientIO ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1334,7 +1334,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a -> Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v) forall a b. b -> Either a b Right (CompressMode -compress, Proxy @GRpcMessageProtocol p +compress, Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) vref -> v -> GRpcIWTy @Symbol p vref v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper @snm p ref r => @@ -1342,10 +1342,10 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm p ref r buildGRpcIWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) vref +Proxy @p) (Proxy @(TypeRef Symbol) vref forall k (t :: k). Proxy @k t -Proxy @vref) v -v))) +Proxy @vref) v +v))) ConduitT v Void IO (GRpcReply ()) -> IO (ConduitT v Void IO (GRpcReply ())) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1355,15 +1355,15 @@ forall (m :: * -> *) a b o. MonadIO m => TMChan a -> Async b -> ConduitT a o m b conduitFromChannel TMChan v -chan Async (GRpcReply ()) -promise) +chan Async (GRpcReply ()) +promise) -instance ( KnownName name - , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r - , handler ~ (CompressMode -> IO (ConduitT v Void IO (GRpcReply r))) ) - => GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ] - ('RetSingle rref)) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r + , handler ~ (CompressMode -> IO (ConduitT v Void IO (GRpcReply r))) ) + => GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ] + ('RetSingle rref)) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -1380,8 +1380,8 @@ TMChan a -> Async b -> ConduitT a o m b ('RetSingle @* @(TypeRef Symbol) @Symbol rref)) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -1395,17 +1395,17 @@ TMChan a -> Async b -> ConduitT a o m b ('ArgStream @* @Symbol @(TypeRef Symbol) @Symbol aname vref) ('[] @(Argument @* Symbol Symbol (TypeRef Symbol)))) ('RetSingle @* @(TypeRef Symbol) @Symbol rref)) -_ GrpcClient -client CompressMode -compress +_ GrpcClient +client CompressMode +compress = do -- Create a new TMChan - TMChan v -chan <- IO (TMChan v) + TMChan v +chan <- IO (TMChan v) forall a. IO (TMChan a) -newTMChanIO :: IO (TMChan v) +newTMChanIO :: IO (TMChan v) -- Start executing the client in another thread - Async (GRpcReply r) -promise <- IO (GRpcReply r) -> IO (Async (GRpcReply r)) + Async (GRpcReply r) +promise <- IO (GRpcReply r) -> IO (Async (GRpcReply r)) forall a. IO a -> IO (Async a) async (IO (GRpcReply r) -> IO (Async (GRpcReply r))) -> IO (GRpcReply r) -> IO (Async (GRpcReply r)) @@ -1425,9 +1425,9 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm p ref r -> r unGRpcOWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) rref +Proxy @p) (Proxy @(TypeRef Symbol) rref forall k (t :: k). Proxy @k t -Proxy @rref))) (IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r)) +Proxy @rref))) (IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r)) -> IO (GRpcReply (GRpcOWTy @Symbol p rref r)) -> IO (GRpcReply r) forall a b. (a -> b) -> a -> b $ @@ -1474,12 +1474,12 @@ r -> a -> (a -> ClientIO (a, Either StreamDone (CompressMode, i))) -> ClientIO (Either TooMuchConcurrency (a, RawReply o)) -rawStreamClient @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) RPCTy p -rpc GrpcClient -client () +rawStreamClient @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) RPCTy p +rpc GrpcClient +client () (\() -_ -> do Maybe v -nextVal <- IO (Maybe v) -> ExceptT ClientError IO (Maybe v) +_ -> do Maybe v +nextVal <- IO (Maybe v) -> ExceptT ClientError IO (Maybe v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe v) -> ExceptT ClientError IO (Maybe v)) -> IO (Maybe v) -> ExceptT ClientError IO (Maybe v) @@ -1491,9 +1491,9 @@ forall a b. (a -> b) -> a -> b $ TMChan v -> STM (Maybe v) forall a. TMChan a -> STM (Maybe a) readTMChan TMChan v -chan +chan case Maybe v -nextVal of +nextVal of Maybe v Nothing -> ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) -> ClientIO @@ -1504,8 +1504,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a b. a -> Either a b Left StreamDone StreamDone) - Just v -v -> ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) + Just v +v -> ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) -> ClientIO ((), Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1513,7 +1513,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a -> Either StreamDone (CompressMode, GRpcIWTy @Symbol p vref v) forall a b. b -> Either a b Right (CompressMode -compress, Proxy @GRpcMessageProtocol p +compress, Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) vref -> v -> GRpcIWTy @Symbol p vref v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper @snm p ref r => @@ -1521,10 +1521,10 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm p ref r buildGRpcIWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) vref +Proxy @p) (Proxy @(TypeRef Symbol) vref forall k (t :: k). Proxy @k t -Proxy @vref) v -v))) +Proxy @vref) v +v))) ConduitT v Void IO (GRpcReply r) -> IO (ConduitT v Void IO (GRpcReply r)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -1533,24 +1533,24 @@ forall (m :: * -> *) a b o. MonadIO m => TMChan a -> Async b -> ConduitT a o m b conduitFromChannel TMChan v -chan Async (GRpcReply r) -promise) +chan Async (GRpcReply r) +promise) -conduitFromChannel :: MonadIO m => TMChan a -> Async b -> ConduitT a o m b +conduitFromChannel :: MonadIO m => TMChan a -> Async b -> ConduitT a o m b conduitFromChannel :: TMChan a -> Async b -> ConduitT a o m b -conduitFromChannel TMChan a -chan Async b -promise = ConduitT a o m b -go - where go :: ConduitT a o m b -go = do Maybe a -x <- ConduitT a o m (Maybe a) +conduitFromChannel TMChan a +chan Async b +promise = ConduitT a o m b +go + where go :: ConduitT a o m b +go = do Maybe a +x <- ConduitT a o m (Maybe a) forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i) await case Maybe a -x of - Just a -v -> do IO () -> ConduitT a o m () +x of + Just a +v -> do IO () -> ConduitT a o m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ConduitT a o m ()) -> IO () -> ConduitT a o m () forall a b. (a -> b) -> a -> b @@ -1561,10 +1561,10 @@ forall a b. (a -> b) -> a -> b $ TMChan a -> a -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan a -chan a -v +chan a +v ConduitT a o m b -go +go Maybe a Nothing -> do IO () -> ConduitT a o m () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1577,7 +1577,7 @@ forall a b. (a -> b) -> a -> b $ TMChan a -> STM () forall a. TMChan a -> STM () closeTMChan TMChan a -chan +chan IO b -> ConduitT a o m b forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO b -> ConduitT a o m b) -> IO b -> ConduitT a o m b @@ -1585,14 +1585,14 @@ forall a b. (a -> b) -> a -> b $ Async b -> IO b forall a. Async a -> IO a wait Async b -promise +promise -instance ( KnownName name - , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r - , handler ~ (CompressMode -> IO (ConduitT v Void IO (), ConduitT () r IO (GRpcReply ())))) - => GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ] - ('RetStream rref)) handler where - gRpcMethodCall :: RPCTy p +instance ( KnownName name + , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r + , handler ~ (CompressMode -> IO (ConduitT v Void IO (), ConduitT () r IO (GRpcReply ())))) + => GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ] + ('RetStream rref)) handler where + gRpcMethodCall :: RPCTy p -> Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @@ -1609,8 +1609,8 @@ forall a. Async a -> IO a ('RetStream @* @(TypeRef Symbol) @Symbol rref)) -> GrpcClient -> handler -gRpcMethodCall RPCTy p -rpc Proxy +gRpcMethodCall RPCTy p +rpc Proxy @(Method @* Symbol Symbol Symbol (TypeRef Symbol)) ('Method @* @@ -1624,19 +1624,19 @@ forall a. Async a -> IO a ('ArgStream @* @Symbol @(TypeRef Symbol) @Symbol aname vref) ('[] @(Argument @* Symbol Symbol (TypeRef Symbol)))) ('RetStream @* @(TypeRef Symbol) @Symbol rref)) -_ GrpcClient -client CompressMode -compress - = do TMChan r -serverChan <- IO (TMChan r) +_ GrpcClient +client CompressMode +compress + = do TMChan r +serverChan <- IO (TMChan r) forall a. IO (TMChan a) -newTMChanIO :: IO (TMChan r) - TMChan v -clientChan <- IO (TMChan v) +newTMChanIO :: IO (TMChan r) + TMChan v +clientChan <- IO (TMChan v) forall a. IO (TMChan a) -newTMChanIO :: IO (TMChan v) - TMVar (GRpcReply ()) -finalReply <- IO (TMVar (GRpcReply ())) +newTMChanIO :: IO (TMChan v) + TMVar (GRpcReply ()) +finalReply <- IO (TMVar (GRpcReply ())) forall a. IO (TMVar a) newEmptyTMVarIO :: IO (TMVar (GRpcReply ())) -- Start executing the client in another thread @@ -1647,8 +1647,8 @@ forall a. IO a -> IO (Async a) async (IO () -> IO (Async ())) -> IO () -> IO (Async ()) forall a b. (a -> b) -> a -> b $ do - GRpcReply () -v <- ClientIO (GRpcReply ()) -> IO (GRpcReply ()) + GRpcReply () +v <- ClientIO (GRpcReply ()) -> IO (GRpcReply ()) forall a. ClientIO (GRpcReply a) -> IO (GRpcReply a) simplifyResponse (ClientIO (GRpcReply ()) -> IO (GRpcReply ())) -> ClientIO (GRpcReply ()) -> IO (GRpcReply ()) @@ -1680,21 +1680,21 @@ r -> (b -> ClientIO (b, OutgoingEvent i b)) -> ClientIO (Either TooMuchConcurrency (a, b)) rawGeneralStream - @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) + @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) RPCTy p -rpc GrpcClient -client +rpc GrpcClient +client () (TMChan r -> () -> IncomingEvent (GRpcOWTy @Symbol p rref r) () -> ClientIO () -incomingEventConsumer TMChan r -serverChan) +incomingEventConsumer TMChan r +serverChan) () (TMChan v -> () -> ClientIO ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) -outgoingEventProducer TMChan v -clientChan) +outgoingEventProducer TMChan v +clientChan) IO () -> IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> IO ()) -> IO () -> IO () @@ -1706,16 +1706,16 @@ forall a b. (a -> b) -> a -> b $ TMVar (GRpcReply ()) -> GRpcReply () -> STM () forall a. TMVar a -> a -> STM () putTMVar TMVar (GRpcReply ()) -finalReply GRpcReply () -v - let clientConduit :: ConduitT v Void IO () -clientConduit = do +finalReply GRpcReply () +v + let clientConduit :: ConduitT v Void IO () +clientConduit = do TMChan v -> ConduitT v Void IO () forall (m :: * -> *) a z. MonadIO m => TMChan a -> ConduitT a z m () sinkTMChan TMChan v -clientChan +clientChan IO () -> ConduitT v Void IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ConduitT v Void IO ()) @@ -1731,13 +1731,13 @@ forall a. TMChan a -> STM () -> TMChan v -> ConduitT v Void IO () forall a b. (a -> b) -> a -> b $ TMChan v -clientChan - serverConduit :: ConduitT () r IO (GRpcReply ()) -serverConduit = do +clientChan + serverConduit :: ConduitT () r IO (GRpcReply ()) +serverConduit = do TMChan r -> ConduitT () r IO () forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m () sourceTMChan TMChan r -serverChan +serverChan IO (GRpcReply ()) -> ConduitT () r IO (GRpcReply ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (GRpcReply ()) -> ConduitT () r IO (GRpcReply ())) @@ -1758,27 +1758,27 @@ forall a. TMVar a -> STM a -> TMVar (GRpcReply ()) -> ConduitT () r IO (GRpcReply ()) forall a b. (a -> b) -> a -> b $ TMVar (GRpcReply ()) -finalReply +finalReply (ConduitT v Void IO (), ConduitT () r IO (GRpcReply ())) -> IO (ConduitT v Void IO (), ConduitT () r IO (GRpcReply ())) forall (f :: * -> *) a. Applicative f => a -> f a pure (ConduitT v Void IO () -clientConduit, ConduitT () r IO (GRpcReply ()) -serverConduit) +clientConduit, ConduitT () r IO (GRpcReply ()) +serverConduit) where - incomingEventConsumer :: TMChan r -> () -> IncomingEvent (GRpcOWTy p rref r) () -> ExceptT ClientError IO () - incomingEventConsumer :: TMChan r + incomingEventConsumer :: TMChan r -> () -> IncomingEvent (GRpcOWTy p rref r) () -> ExceptT ClientError IO () + incomingEventConsumer :: TMChan r -> () -> IncomingEvent (GRpcOWTy @Symbol p rref r) () -> ClientIO () -incomingEventConsumer TMChan r -serverChan () -_ IncomingEvent (GRpcOWTy @Symbol p rref r) () -ievent = +incomingEventConsumer TMChan r +serverChan () +_ IncomingEvent (GRpcOWTy @Symbol p rref r) () +ievent = case IncomingEvent (GRpcOWTy @Symbol p rref r) () -ievent of - RecvMessage GRpcOWTy @Symbol p rref r -o -> do +ievent of + RecvMessage GRpcOWTy @Symbol p rref r +o -> do IO () -> ClientIO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ClientIO ()) -> IO () -> ClientIO () @@ -1790,7 +1790,7 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> r -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan r -serverChan (Proxy @GRpcMessageProtocol p +serverChan (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) rref -> GRpcOWTy @Symbol p rref r -> r forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcOutputWrapper @snm p ref r => @@ -1798,12 +1798,12 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> GRpcOWTy @snm p ref r -> r unGRpcOWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) rref +Proxy @p) (Proxy @(TypeRef Symbol) rref forall k (t :: k). Proxy @k t -Proxy @rref) GRpcOWTy @Symbol p rref r -o) - Invalid SomeException -e -> IO () -> ClientIO () +Proxy @rref) GRpcOWTy @Symbol p rref r +o) + Invalid SomeException +e -> IO () -> ClientIO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ClientIO ()) -> IO () -> ClientIO () forall a b. (a -> b) -> a -> b @@ -1815,11 +1815,11 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> STM () forall a. TMChan a -> STM () closeTMChan TMChan r -serverChan +serverChan SomeException -> IO () forall e a. Exception e => e -> IO a throwIO SomeException -e +e Trailers [(ByteString, ByteString)] _ -> -- TODO: Read the trailers and use them to make the 'finalReply' @@ -1834,7 +1834,7 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> STM () forall a. TMChan a -> STM () closeTMChan TMChan r -serverChan +serverChan Headers [(ByteString, ByteString)] _ -> -- TODO: Read the headers and use them to make the 'finalReply' @@ -1842,15 +1842,15 @@ forall a. TMChan a -> STM () forall (f :: * -> *) a. Applicative f => a -> f a pure () - outgoingEventProducer :: TMChan v -> () -> ExceptT ClientError IO ((), OutgoingEvent (GRpcIWTy p vref v) ()) - outgoingEventProducer :: TMChan v + outgoingEventProducer :: TMChan v -> () -> ExceptT ClientError IO ((), OutgoingEvent (GRpcIWTy p vref v) ()) + outgoingEventProducer :: TMChan v -> () -> ClientIO ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) -outgoingEventProducer TMChan v -clientChan () +outgoingEventProducer TMChan v +clientChan () _ = do - Maybe v -nextVal <- IO (Maybe v) -> ExceptT ClientError IO (Maybe v) + Maybe v +nextVal <- IO (Maybe v) -> ExceptT ClientError IO (Maybe v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe v) -> ExceptT ClientError IO (Maybe v)) -> IO (Maybe v) -> ExceptT ClientError IO (Maybe v) @@ -1862,9 +1862,9 @@ forall a b. (a -> b) -> a -> b $ TMChan v -> STM (Maybe v) forall a. TMChan a -> STM (Maybe a) readTMChan TMChan v -clientChan +clientChan case Maybe v -nextVal of +nextVal of Maybe v Nothing -> ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) -> ClientIO ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) @@ -1872,8 +1872,8 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) () forall i b. OutgoingEvent i b Finalize) - Just v -v -> ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) + Just v +v -> ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) -> ClientIO ((), OutgoingEvent (GRpcIWTy @Symbol p vref v) ()) forall (f :: * -> *) a. Applicative f => a -> f a pure ((), CompressMode @@ -1881,7 +1881,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a -> OutgoingEvent (GRpcIWTy @Symbol p vref v) () forall i b. CompressMode -> i -> OutgoingEvent i b SendMessage CompressMode -compress (Proxy @GRpcMessageProtocol p +compress (Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef Symbol) vref -> v -> GRpcIWTy @Symbol p vref v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper @snm p ref r => @@ -1889,8 +1889,8 @@ Proxy @GRpcMessageProtocol p -> Proxy @(TypeRef snm) ref -> r -> GRpcIWTy @snm p ref r buildGRpcIWTy (Proxy @GRpcMessageProtocol p forall k (t :: k). Proxy @k t -Proxy @p) (Proxy @(TypeRef Symbol) vref +Proxy @p) (Proxy @(TypeRef Symbol) vref forall k (t :: k). Proxy @k t -Proxy @vref) v -v)) +Proxy @vref) v +v)) \ No newline at end of file diff --git a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Optics.html b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Optics.html index 9da7419..b0a0516 100644 --- a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Optics.html +++ b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Optics.html @@ -52,7 +52,7 @@ consult the <http://hackage.haskell.org/package/http2-client-grpc http2-clien import Mu.Schema.Optics -- | Represents a connection to the service @s@. -newtype GRpcConnection (s :: Package') (p :: GRpcMessageProtocol) +newtype GRpcConnection (s :: Package') (p :: GRpcMessageProtocol) = GRpcConnection { GRpcConnection s p -> GrpcClient gcClient :: G.GrpcClient } @@ -63,24 +63,24 @@ consult the <http://hackage.haskell.org/package/http2-client-grpc http2-clien -- -- > initGRpc config msgProtoBuf @Service -- -initGRpc :: MonadIO m +initGRpc :: MonadIO m => G.GrpcClientConfig -- ^ gRPC configuration - -> Proxy p - -> forall s. m (Either ClientError (GRpcConnection s p)) + -> Proxy p + -> forall s. m (Either ClientError (GRpcConnection s p)) initGRpc :: GrpcClientConfig -> Proxy p -> forall (s :: Package'). m (Either ClientError (GRpcConnection s p)) -initGRpc GrpcClientConfig -config Proxy p +initGRpc GrpcClientConfig +config Proxy p _ = do - Either ClientError GrpcClient -setup <- GrpcClientConfig -> m (Either ClientError GrpcClient) + Either ClientError GrpcClient +setup <- GrpcClientConfig -> m (Either ClientError GrpcClient) forall (m :: * -> *). MonadIO m => GrpcClientConfig -> m (Either ClientError GrpcClient) setupGrpcClient' GrpcClientConfig -config +config Either ClientError (GRpcConnection s p) -> m (Either ClientError (GRpcConnection s p)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -90,14 +90,14 @@ forall (f :: * -> *) a. Applicative f => a -> f a -> m (Either ClientError (GRpcConnection s p)) forall a b. (a -> b) -> a -> b $ case Either ClientError GrpcClient -setup of - Left ClientError -e -> ClientError -> Either ClientError (GRpcConnection s p) +setup of + Left ClientError +e -> ClientError -> Either ClientError (GRpcConnection s p) forall a b. a -> Either a b Left ClientError -e - Right GrpcClient -c -> GRpcConnection s p -> Either ClientError (GRpcConnection s p) +e + Right GrpcClient +c -> GRpcConnection s p -> Either ClientError (GRpcConnection s p) forall a b. b -> Either a b Right (GRpcConnection s p -> Either ClientError (GRpcConnection s p)) -> GRpcConnection s p -> Either ClientError (GRpcConnection s p) @@ -106,7 +106,7 @@ forall a b. (a -> b) -> a -> b forall (s :: Package') (p :: GRpcMessageProtocol). GrpcClient -> GRpcConnection s p GRpcConnection GrpcClient -c +c -- | Initializes a connection to a gRPC server, -- creating a new span for distributed tracing. @@ -116,28 +116,28 @@ GrpcClient -> GRpcConnection s p -- -- > initGRpcZipkin config msgProtoBuf "person" @Service -- -initGRpcZipkin :: (MonadIO m, MonadTrace m) +initGRpcZipkin :: (MonadIO m, MonadTrace m) => G.GrpcClientConfig -- ^ gRPC configuration - -> Proxy p + -> Proxy p -> T.Text - -> forall s. m (Either ClientError (GRpcConnection s p)) + -> forall s. m (Either ClientError (GRpcConnection s p)) initGRpcZipkin :: GrpcClientConfig -> Proxy p -> Text -> forall (s :: Package'). m (Either ClientError (GRpcConnection s p)) -initGRpcZipkin GrpcClientConfig -config Proxy p -_ Text -spanName = do - Either ClientError GrpcClient -setup <- GrpcClientConfig -> Text -> m (Either ClientError GrpcClient) +initGRpcZipkin GrpcClientConfig +config Proxy p +_ Text +spanName = do + Either ClientError GrpcClient +setup <- GrpcClientConfig -> Text -> m (Either ClientError GrpcClient) forall (m :: * -> *). (MonadIO m, MonadTrace m) => GrpcClientConfig -> Text -> m (Either ClientError GrpcClient) setupGrpcClientZipkin GrpcClientConfig -config Text -spanName +config Text +spanName Either ClientError (GRpcConnection s p) -> m (Either ClientError (GRpcConnection s p)) forall (f :: * -> *) a. Applicative f => a -> f a @@ -147,14 +147,14 @@ forall (f :: * -> *) a. Applicative f => a -> f a -> m (Either ClientError (GRpcConnection s p)) forall a b. (a -> b) -> a -> b $ case Either ClientError GrpcClient -setup of - Left ClientError -e -> ClientError -> Either ClientError (GRpcConnection s p) +setup of + Left ClientError +e -> ClientError -> Either ClientError (GRpcConnection s p) forall a b. a -> Either a b Left ClientError -e - Right GrpcClient -c -> GRpcConnection s p -> Either ClientError (GRpcConnection s p) +e + Right GrpcClient +c -> GRpcConnection s p -> Either ClientError (GRpcConnection s p) forall a b. b -> Either a b Right (GRpcConnection s p -> Either ClientError (GRpcConnection s p)) -> GRpcConnection s p -> Either ClientError (GRpcConnection s p) @@ -163,24 +163,24 @@ forall a b. (a -> b) -> a -> b forall (s :: Package') (p :: GRpcMessageProtocol). GrpcClient -> GRpcConnection s p GRpcConnection GrpcClient -c +c -instance forall (pkg :: Package') (pkgName :: Symbol) - (service :: Service') (serviceName :: Symbol) - (methods :: [Method']) - (p :: GRpcMessageProtocol) (m :: Symbol) t. - ( pkg ~ 'Package ('Just pkgName) '[service] - , service ~ 'Service serviceName methods - , SearchMethodOptic p methods m t - , KnownName serviceName - , KnownName pkgName - , KnownName m - , MkRPC p ) - => LabelOptic m A_Getter - (GRpcConnection pkg p) - (GRpcConnection pkg p) - t t where - labelOptic :: Optic +instance forall (pkg :: Package') (pkgName :: Symbol) + (service :: Service') (serviceName :: Symbol) + (methods :: [Method']) + (p :: GRpcMessageProtocol) (m :: Symbol) t. + ( pkg ~ 'Package ('Just pkgName) '[service] + , service ~ 'Service serviceName methods + , SearchMethodOptic p methods m t + , KnownName serviceName + , KnownName pkgName + , KnownName m + , MkRPC p ) + => LabelOptic m A_Getter + (GRpcConnection pkg p) + (GRpcConnection pkg p) + t t where + labelOptic :: Optic A_Getter NoIx (GRpcConnection pkg p) (GRpcConnection pkg p) t t labelOptic = (GRpcConnection pkg p -> t) -> Optic @@ -191,12 +191,12 @@ forall (p :: GRpcMessageProtocol) (methods :: [Method']) (m :: Symbol) t. SearchMethodOptic p methods m t => Proxy methods -> Proxy m -> RPCTy p -> GrpcClient -> t -searchMethodOptic @p (Proxy methods +searchMethodOptic @p (Proxy methods forall k (t :: k). Proxy t -Proxy @methods) (Proxy m +Proxy @methods) (Proxy m forall k (t :: k). Proxy t -Proxy @m) RPCTy p -rpc (GrpcClient -> t) +Proxy @m) RPCTy p +rpc (GrpcClient -> t) -> (GRpcConnection pkg p -> GrpcClient) -> GRpcConnection pkg p -> t @@ -205,134 +205,134 @@ forall b c a. (b -> c) -> (a -> b) -> a -> c forall (s :: Package') (p :: GRpcMessageProtocol). GRpcConnection s p -> GrpcClient gcClient) - where pkgName :: ByteString -pkgName = String -> ByteString + where pkgName :: ByteString +pkgName = String -> ByteString BS.pack (Proxy pkgName -> String forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> String nameVal (Proxy pkgName forall k (t :: k). Proxy t -Proxy @pkgName)) - svrName :: ByteString -svrName = String -> ByteString +Proxy @pkgName)) + svrName :: ByteString +svrName = String -> ByteString BS.pack (Proxy serviceName -> String forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> String nameVal (Proxy serviceName forall k (t :: k). Proxy t -Proxy @serviceName)) - metName :: ByteString -metName = String -> ByteString +Proxy @serviceName)) + metName :: ByteString +metName = String -> ByteString BS.pack (Proxy m -> String forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> String nameVal (Proxy m forall k (t :: k). Proxy t -Proxy @m)) - rpc :: RPCTy p -rpc = Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p +Proxy @m)) + rpc :: RPCTy p +rpc = Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p forall (p :: GRpcMessageProtocol). MkRPC p => Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p mkRPC (Proxy p forall k (t :: k). Proxy t -Proxy @p) ByteString -pkgName ByteString -svrName ByteString -metName +Proxy @p) ByteString +pkgName ByteString +svrName ByteString +metName -class SearchMethodOptic (p :: GRpcMessageProtocol) (methods :: [Method']) (m :: Symbol) t - | p methods m -> t where - searchMethodOptic :: Proxy methods -> Proxy m -> RPCTy p -> G.GrpcClient -> t +class SearchMethodOptic (p :: GRpcMessageProtocol) (methods :: [Method']) (m :: Symbol) t + | p methods m -> t where + searchMethodOptic :: Proxy methods -> Proxy m -> RPCTy p -> G.GrpcClient -> t {- Not possible due to functional dependency instance TypeError ('Text "could not find method " ':<>: ShowType m) => SearchMethodOptic '[] m t where -} -instance {-# OVERLAPS #-} MethodOptic p ('Method name ins outs) t - => SearchMethodOptic p ('Method name ins outs ': rest) name t where - searchMethodOptic :: Proxy ('Method name ins outs : rest) +instance {-# OVERLAPS #-} MethodOptic p ('Method name ins outs) t + => SearchMethodOptic p ('Method name ins outs ': rest) name t where + searchMethodOptic :: Proxy ('Method name ins outs : rest) -> Proxy name -> RPCTy p -> GrpcClient -> t -searchMethodOptic Proxy ('Method name ins outs : rest) +searchMethodOptic Proxy ('Method name ins outs : rest) _ Proxy name -_ RPCTy p -rpc = RPCTy p -> Proxy ('Method name ins outs) -> GrpcClient -> t +_ RPCTy p +rpc = RPCTy p -> Proxy ('Method name ins outs) -> GrpcClient -> t forall (p :: GRpcMessageProtocol) (method :: Method') t. MethodOptic p method t => RPCTy p -> Proxy method -> GrpcClient -> t -methodOptic @p RPCTy p -rpc (Proxy ('Method name ins outs) +methodOptic @p RPCTy p +rpc (Proxy ('Method name ins outs) forall k (t :: k). Proxy t -Proxy @('Method name ins outs)) -instance {-# OVERLAPPABLE #-} SearchMethodOptic p rest name t - => SearchMethodOptic p ('Method other ins outs ': rest) name t where - searchMethodOptic :: Proxy ('Method other ins outs : rest) +Proxy @('Method name ins outs)) +instance {-# OVERLAPPABLE #-} SearchMethodOptic p rest name t + => SearchMethodOptic p ('Method other ins outs ': rest) name t where + searchMethodOptic :: Proxy ('Method other ins outs : rest) -> Proxy name -> RPCTy p -> GrpcClient -> t -searchMethodOptic Proxy ('Method other ins outs : rest) +searchMethodOptic Proxy ('Method other ins outs : rest) _ = Proxy rest -> Proxy name -> RPCTy p -> GrpcClient -> t forall (p :: GRpcMessageProtocol) (methods :: [Method']) (m :: Symbol) t. SearchMethodOptic p methods m t => Proxy methods -> Proxy m -> RPCTy p -> GrpcClient -> t -searchMethodOptic @p (Proxy rest +searchMethodOptic @p (Proxy rest forall k (t :: k). Proxy t -Proxy @rest) +Proxy @rest) -class GRpcMethodCall p method t - => MethodOptic (p :: GRpcMessageProtocol) (method :: Method') t - | p method -> t where - methodOptic :: RPCTy p -> Proxy method -> G.GrpcClient -> t - methodOptic = forall (p :: GRpcMessageProtocol) (method :: Method') h. +class GRpcMethodCall p method t + => MethodOptic (p :: GRpcMessageProtocol) (method :: Method') t + | p method -> t where + methodOptic :: RPCTy p -> Proxy method -> G.GrpcClient -> t + methodOptic = forall (p :: GRpcMessageProtocol) (method :: Method') h. GRpcMethodCall p method h => RPCTy p -> Proxy method -> GrpcClient -> h forall (method :: Method') h. GRpcMethodCall p method h => RPCTy p -> Proxy method -> GrpcClient -> h -gRpcMethodCall @p +gRpcMethodCall @p -- No arguments -instance forall (name :: Symbol) t p. - ( GRpcMethodCall p ('Method name '[ ] 'RetNothing) t - , t ~ IO (GRpcReply ()) ) - => MethodOptic p ('Method name '[ ] 'RetNothing) t -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) t p. - ( GRpcMethodCall p ('Method name '[ ] ('RetSingle ('SchemaRef sch r))) t - , t ~ IO (GRpcReply (Term sch (sch :/: r))) ) - => MethodOptic p ('Method name '[ ] ('RetSingle ('SchemaRef sch r))) t -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) t p. - ( GRpcMethodCall p ('Method name '[ ] ('RetStream ('SchemaRef sch r))) t - , t ~ IO (ConduitT () (GRpcReply (Term sch (sch :/: r))) IO ()) ) - => MethodOptic p ('Method name '[ ] ('RetStream ('SchemaRef sch r))) t +instance forall (name :: Symbol) t p. + ( GRpcMethodCall p ('Method name '[ ] 'RetNothing) t + , t ~ IO (GRpcReply ()) ) + => MethodOptic p ('Method name '[ ] 'RetNothing) t +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) t p. + ( GRpcMethodCall p ('Method name '[ ] ('RetSingle ('SchemaRef sch r))) t + , t ~ IO (GRpcReply (Term sch (sch :/: r))) ) + => MethodOptic p ('Method name '[ ] ('RetSingle ('SchemaRef sch r))) t +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) t p. + ( GRpcMethodCall p ('Method name '[ ] ('RetStream ('SchemaRef sch r))) t + , t ~ IO (ConduitT () (GRpcReply (Term sch (sch :/: r))) IO ()) ) + => MethodOptic p ('Method name '[ ] ('RetStream ('SchemaRef sch r))) t -- Simple arguments -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) aname t p. - ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] 'RetNothing) t - , t ~ (Term sch (sch :/: v) -> IO (GRpcReply ())) ) - => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] 'RetNothing) t -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. - ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t - , t ~ (Term sch (sch :/: v) - -> IO (GRpcReply (Term sch (sch :/: r))) ) ) - => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. - ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t - , t ~ (Term sch (sch :/: v) - -> IO (ConduitT () (GRpcReply (Term sch (sch :/: r))) IO ()) ) ) - => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) aname t p. + ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] 'RetNothing) t + , t ~ (Term sch (sch :/: v) -> IO (GRpcReply ())) ) + => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] 'RetNothing) t +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. + ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t + , t ~ (Term sch (sch :/: v) + -> IO (GRpcReply (Term sch (sch :/: r))) ) ) + => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. + ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t + , t ~ (Term sch (sch :/: v) + -> IO (ConduitT () (GRpcReply (Term sch (sch :/: r))) IO ()) ) ) + => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t -- Stream arguments -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. - ( GRpcMethodCall p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t - , t ~ (CompressMode - -> IO (ConduitT (Term sch (sch :/: v)) +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. + ( GRpcMethodCall p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t + , t ~ (CompressMode + -> IO (ConduitT (Term sch (sch :/: v)) Void IO - (GRpcReply (Term sch (sch :/: r))))) ) - => MethodOptic p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t -instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. - ( GRpcMethodCall p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t - , t ~ (CompressMode - -> IO (ConduitT (Term sch (sch :/: v)) - (GRpcReply (Term sch (sch :/: r))) IO ())) ) - => MethodOptic p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t + (GRpcReply (Term sch (sch :/: r))))) ) + => MethodOptic p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t +instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p. + ( GRpcMethodCall p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t + , t ~ (CompressMode + -> IO (ConduitT (Term sch (sch :/: v)) + (GRpcReply (Term sch (sch :/: r))) IO ())) ) + => MethodOptic p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetStream ('SchemaRef sch r))) t \ No newline at end of file diff --git a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Record.html b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Record.html index 38308cd..c328628 100644 --- a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Record.html +++ b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.Record.html @@ -50,18 +50,18 @@ consult the <http://hackage.haskell.org/package/http2-client-grpc http2-clien -- | Fills in a Haskell record of functions with the corresponding -- calls to gRPC services from a Mu 'Service' declaration. -buildService :: forall (pro :: GRpcMessageProtocol) - (pkg :: Package') (s :: Symbol) (p :: Symbol) t - (pkgName :: Symbol) (ss :: [Service']) - (ms :: [Method']). - ( pkg ~ 'Package ('Just pkgName) ss - , LookupService ss s ~ 'Service s ms - , Generic t - , BuildService pro pkgName s p ms (Rep t) ) - => GrpcClient -> t +buildService :: forall (pro :: GRpcMessageProtocol) + (pkg :: Package') (s :: Symbol) (p :: Symbol) t + (pkgName :: Symbol) (ss :: [Service']) + (ms :: [Method']). + ( pkg ~ 'Package ('Just pkgName) ss + , LookupService ss s ~ 'Service s ms + , Generic t + , BuildService pro pkgName s p ms (Rep t) ) + => GrpcClient -> t buildService :: GrpcClient -> t -buildService GrpcClient -client +buildService GrpcClient +client = Rep t Any -> t forall a x. Generic a => Rep a x -> a to (Proxy pro @@ -78,30 +78,30 @@ Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a buildService' (Proxy pro forall k (t :: k). Proxy t -Proxy @pro) (Proxy pkgName +Proxy @pro) (Proxy pkgName forall k (t :: k). Proxy t -Proxy @pkgName) (Proxy s +Proxy @pkgName) (Proxy s forall k (t :: k). Proxy t -Proxy @s) (Proxy p +Proxy @s) (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy ms +Proxy @p) (Proxy ms forall k (t :: k). Proxy t -Proxy @ms) GrpcClient -client) +Proxy @ms) GrpcClient +client) -class BuildService (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol) - (p :: Symbol) (ms :: [Method']) (f :: * -> *) where - buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a +class BuildService (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol) + (p :: Symbol) (ms :: [Method']) (f :: * -> *) where + buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a -instance BuildService pro pkg s p ms U1 where - buildService' :: Proxy pro +instance BuildService pro pkg s p ms U1 where + buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> U1 a -buildService' Proxy pro +buildService' Proxy pro _ Proxy pkg _ Proxy s _ Proxy p @@ -110,21 +110,21 @@ forall k (t :: k). Proxy t _ = U1 a forall k (p :: k). U1 p U1 -instance BuildService pro pkg s p ms f => BuildService pro pkg s p ms (D1 meta f) where - buildService' :: Proxy pro +instance BuildService pro pkg s p ms f => BuildService pro pkg s p ms (D1 meta f) where + buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> D1 meta f a -buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client +buildService' Proxy pro +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client = f a -> D1 meta f a forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (Proxy pro @@ -135,27 +135,27 @@ BuildService pro pkg s p ms f => Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client) -instance BuildService pro pkg s p ms f => BuildService pro pkg s p ms (C1 meta f) where - buildService' :: Proxy pro +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client) +instance BuildService pro pkg s p ms f => BuildService pro pkg s p ms (C1 meta f) where + buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> C1 meta f a -buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client +buildService' Proxy pro +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client = f a -> C1 meta f a forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (Proxy pro @@ -166,22 +166,22 @@ BuildService pro pkg s p ms f => Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client) -instance TypeError ('Text "building a service from sums is not supported") - => BuildService pro pkg s p ms (f :+: g) where - buildService' :: Proxy pro +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client) +instance TypeError ('Text "building a service from sums is not supported") + => BuildService pro pkg s p ms (f :+: g) where + buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> (:+:) f g a -buildService' = [Char] +buildService' = [Char] -> Proxy pro -> Proxy pkg -> Proxy s @@ -192,22 +192,22 @@ Proxy pro forall a. HasCallStack => [Char] -> a error [Char] "this should never happen" -instance (BuildService pro pkg s p ms f, BuildService pro pkg s p ms g) - => BuildService pro pkg s p ms (f :*: g) where - buildService' :: Proxy pro +instance (BuildService pro pkg s p ms f, BuildService pro pkg s p ms g) + => BuildService pro pkg s p ms (f :*: g) where + buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> (:*:) f g a -buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client +buildService' Proxy pro +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client = Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a forall (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol) @@ -216,12 +216,12 @@ BuildService pro pkg s p ms f => Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client f a -> g a -> (:*:) f g a +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client f a -> g a -> (:*:) f g a forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p :*: Proxy pro @@ -232,28 +232,28 @@ BuildService pro pkg s p ms f => Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy s -ps Proxy p -ppr Proxy ms -pms GrpcClient -client -instance (m ~ AppendSymbol p x, GRpcServiceMethodCall pro pkg sname (LookupMethod ms x) h) - => BuildService pro pkg sname p ms (S1 ('MetaSel ('Just m) u ss ds) (K1 i h)) where - buildService' :: Proxy pro +ppro Proxy pkg +ppkg Proxy s +ps Proxy p +ppr Proxy ms +pms GrpcClient +client +instance (m ~ AppendSymbol p x, GRpcServiceMethodCall pro pkg sname (LookupMethod ms x) h) + => BuildService pro pkg sname p ms (S1 ('MetaSel ('Just m) u ss ds) (K1 i h)) where + buildService' :: Proxy pro -> Proxy pkg -> Proxy sname -> Proxy p -> Proxy ms -> GrpcClient -> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a -buildService' Proxy pro -ppro Proxy pkg -ppkg Proxy sname -ps Proxy p +buildService' Proxy pro +ppro Proxy pkg +ppkg Proxy sname +ps Proxy p _ Proxy ms -_ GrpcClient -client +_ GrpcClient +client = K1 i h a -> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (K1 i h a -> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a) @@ -274,12 +274,12 @@ forall snm mnm anm (p :: GRpcMessageProtocol) (pkg :: snm) GRpcServiceMethodCall p pkg s m h => Proxy p -> Proxy pkg -> Proxy s -> Proxy m -> GrpcClient -> h gRpcServiceMethodCall Proxy pro -ppro Proxy pkg -ppkg Proxy sname -ps (Proxy (LookupMethod ms x) +ppro Proxy pkg +ppkg Proxy sname +ps (Proxy (LookupMethod ms x) forall k (t :: k). Proxy t -Proxy @(LookupMethod ms x)) GrpcClient -client +Proxy @(LookupMethod ms x)) GrpcClient +client -- TEMPLATE HASKELL -- ================ @@ -289,30 +289,30 @@ forall k (t :: k). Proxy t -- of 'buildService' for that record. generateRecordFromService :: String -> String -> Namer -> Name -> Q [Dec] generateRecordFromService :: [Char] -> [Char] -> Namer -> Name -> Q [Dec] -generateRecordFromService [Char] -newRecordName [Char] -fieldsPrefix Namer -tNamer Name -serviceTyName - = do let serviceTy :: Type -serviceTy = Name -> Type +generateRecordFromService [Char] +newRecordName [Char] +fieldsPrefix Namer +tNamer Name +serviceTyName + = do let serviceTy :: Type +serviceTy = Name -> Type ConT Name -serviceTyName - Maybe (Service [Char] [Char] [Char] (TypeRef Any)) -srvDef <- Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef Any))) +serviceTyName + Maybe (Service [Char] [Char] [Char] (TypeRef Any)) +srvDef <- Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef Any))) forall snm. Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef snm))) typeToServiceDef Type -serviceTy +serviceTy case Maybe (Service [Char] [Char] [Char] (TypeRef Any)) -srvDef of +srvDef of Maybe (Service [Char] [Char] [Char] (TypeRef Any)) Nothing -> [Char] -> Q [Dec] forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "service definition cannot be parsed" - Just Service [Char] [Char] [Char] (TypeRef Any) -sd -> Name + Just Service [Char] [Char] [Char] (TypeRef Any) +sd -> Name -> [Char] -> [Char] -> Namer @@ -326,16 +326,16 @@ Name -> Service [Char] [Char] [Char] (TypeRef snm) -> Q [Dec] serviceDefToDecl Name -serviceTyName [Char] -newRecordName [Char] -fieldsPrefix Namer -tNamer Service [Char] [Char] [Char] (TypeRef Any) -sd +serviceTyName [Char] +newRecordName [Char] +fieldsPrefix Namer +tNamer Service [Char] [Char] [Char] (TypeRef Any) +sd type Namer = String -> String -serviceDefToDecl :: Name -> String -> String -> Namer - -> Service String String String (TypeRef snm) +serviceDefToDecl :: Name -> String -> String -> Namer + -> Service String String String (TypeRef snm) -> Q [Dec] serviceDefToDecl :: Name -> [Char] @@ -343,15 +343,15 @@ Name -> Namer -> Service [Char] [Char] [Char] (TypeRef snm) -> Q [Dec] -serviceDefToDecl Name -serviceTyName [Char] -complete [Char] -fieldsPrefix Namer -tNamer (Service [Char] -_ [Method [Char] [Char] [Char] (TypeRef snm)] -methods) - = do Dec -d <- CxtQ +serviceDefToDecl Name +serviceTyName [Char] +complete [Char] +fieldsPrefix Namer +tNamer (Service [Char] +_ [Method [Char] [Char] [Char] (TypeRef snm)] +methods) + = do Dec +d <- CxtQ -> Name -> [TyVarBndr] -> Maybe Type @@ -363,7 +363,7 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure []) ([Char] -> Name mkName [Char] -complete) +complete) [] Maybe Type forall a. Maybe a @@ -371,7 +371,7 @@ forall a. Maybe a [Name -> [VarBangType] -> Con RecC ([Char] -> Name mkName [Char] -complete) ([VarBangType] -> Con) -> Q [VarBangType] -> ConQ +complete) ([VarBangType] -> Con) -> Q [VarBangType] -> ConQ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Method [Char] [Char] [Char] (TypeRef snm) -> Q VarBangType) -> [Method [Char] [Char] [Char] (TypeRef snm)] -> Q [VarBangType] @@ -388,9 +388,9 @@ forall snm. -> Method [Char] [Char] [Char] (TypeRef snm) -> Q VarBangType methodToDecl [Char] -fieldsPrefix Namer -tNamer) [Method [Char] [Char] [Char] (TypeRef snm)] -methods] +fieldsPrefix Namer +tNamer) [Method [Char] [Char] [Char] (TypeRef snm)] +methods] [DerivClause -> DerivClauseQ forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe DerivStrategy -> [Type] -> DerivClause @@ -398,21 +398,21 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall a. Maybe a Nothing [Name -> Type ConT ''Generic])] - let buildName :: Name -buildName = [Char] -> Name + let buildName :: Name +buildName = [Char] -> Name mkName ([Char] "build" [Char] -> Namer forall a. [a] -> [a] -> [a] ++ [Char] -complete) - Dec -s <- Name -> Type -> Dec +complete) + Dec +s <- Name -> Type -> Dec SigD Name -buildName (Type -> Dec) -> Q Type -> DecQ +buildName (Type -> Dec) -> Q Type -> DecQ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [t|GrpcClient -> $(pure (ConT (mkName complete)))|] - Clause -c <- [Pat] -> Body -> [Dec] -> Clause + Clause +c <- [Pat] -> Body -> [Dec] -> Clause Clause [] (Body -> [Dec] -> Clause) -> Q Body -> Q ([Dec] -> Clause) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Exp -> Body @@ -428,34 +428,34 @@ forall (f :: * -> *) a. Applicative f => a -> f a [Dec] -> Q [Dec] forall (f :: * -> *) a. Applicative f => a -> f a pure [Dec -d, Dec -s, Name -> [Clause] -> Dec +d, Dec +s, Name -> [Clause] -> Dec FunD Name -buildName [Clause -c]] +buildName [Clause +c]] -methodToDecl :: String -> Namer - -> Method String String String (TypeRef snm) +methodToDecl :: String -> Namer + -> Method String String String (TypeRef snm) -> Q (Name, Bang, Type) methodToDecl :: [Char] -> Namer -> Method [Char] [Char] [Char] (TypeRef snm) -> Q VarBangType -methodToDecl [Char] -fieldsPrefix Namer -tNamer (Method [Char] -mName [Argument [Char] [Char] (TypeRef snm)] -args Return [Char] (TypeRef snm) -ret) - = do let nm :: [Char] -nm = Namer +methodToDecl [Char] +fieldsPrefix Namer +tNamer (Method [Char] +mName [Argument [Char] [Char] (TypeRef snm)] +args Return [Char] (TypeRef snm) +ret) + = do let nm :: [Char] +nm = Namer firstLower ([Char] -fieldsPrefix [Char] -> Namer +fieldsPrefix [Char] -> Namer forall a. [a] -> [a] -> [a] ++ [Char] -mName) - Type -ty <- Namer +mName) + Type +ty <- Namer -> [Argument [Char] [Char] (TypeRef snm)] -> Return [Char] (TypeRef snm) -> Q Type @@ -465,22 +465,22 @@ Namer -> Return [Char] (TypeRef snm) -> Q Type computeMethodType Namer -tNamer [Argument [Char] [Char] (TypeRef snm)] -args Return [Char] (TypeRef snm) -ret +tNamer [Argument [Char] [Char] (TypeRef snm)] +args Return [Char] (TypeRef snm) +ret VarBangType -> Q VarBangType forall (f :: * -> *) a. Applicative f => a -> f a pure ( [Char] -> Name mkName [Char] -nm, SourceUnpackedness -> SourceStrictness -> Bang +nm, SourceUnpackedness -> SourceStrictness -> Bang Bang SourceUnpackedness NoSourceUnpackedness SourceStrictness NoSourceStrictness, Type -ty ) +ty ) -computeMethodType :: Namer - -> [Argument String String (TypeRef snm)] - -> Return String (TypeRef snm) +computeMethodType :: Namer + -> [Argument String String (TypeRef snm)] + -> Return String (TypeRef snm) -> Q Type computeMethodType :: Namer -> [Argument [Char] [Char] (TypeRef snm)] @@ -490,39 +490,39 @@ forall (f :: * -> *) a. Applicative f => a -> f a _ [] Return [Char] (TypeRef snm) RetNothing = [t|IO (GRpcReply ())|] -computeMethodType Namer -n [] (RetSingle TypeRef snm -r) +computeMethodType Namer +n [] (RetSingle TypeRef snm +r) = [t|IO (GRpcReply $(typeRefToType n r))|] -computeMethodType Namer -n [ArgSingle Maybe [Char] -_ TypeRef snm -v] Return [Char] (TypeRef snm) +computeMethodType Namer +n [ArgSingle Maybe [Char] +_ TypeRef snm +v] Return [Char] (TypeRef snm) RetNothing = [t|$(typeRefToType n v) -> IO (GRpcReply ())|] -computeMethodType Namer -n [ArgSingle Maybe [Char] -_ TypeRef snm -v] (RetSingle TypeRef snm -r) +computeMethodType Namer +n [ArgSingle Maybe [Char] +_ TypeRef snm +v] (RetSingle TypeRef snm +r) = [t|$(typeRefToType n v) -> IO (GRpcReply $(typeRefToType n r))|] -computeMethodType Namer -n [ArgStream Maybe [Char] -_ TypeRef snm -v] (RetSingle TypeRef snm -r) +computeMethodType Namer +n [ArgStream Maybe [Char] +_ TypeRef snm +v] (RetSingle TypeRef snm +r) = [t|CompressMode -> IO (ConduitT $(typeRefToType n v) Void IO (GRpcReply $(typeRefToType n r)))|] -computeMethodType Namer -n [ArgSingle Maybe [Char] -_ TypeRef snm -v] (RetStream TypeRef snm -r) +computeMethodType Namer +n [ArgSingle Maybe [Char] +_ TypeRef snm +v] (RetStream TypeRef snm +r) = [t|$(typeRefToType n v) -> IO (ConduitT () (GRpcReply $(typeRefToType n r)) IO ())|] -computeMethodType Namer -n [ArgStream Maybe [Char] -_ TypeRef snm -v] (RetStream TypeRef snm -r) +computeMethodType Namer +n [ArgStream Maybe [Char] +_ TypeRef snm +v] (RetStream TypeRef snm +r) = [t|CompressMode -> IO (ConduitT $(typeRefToType n v) (GRpcReply $(typeRefToType n r)) IO ())|] computeMethodType Namer _ [Argument [Char] [Char] (TypeRef snm)] @@ -532,11 +532,11 @@ forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "method signature not supported" -typeRefToType :: Namer -> TypeRef snm -> Q Type +typeRefToType :: Namer -> TypeRef snm -> Q Type typeRefToType :: Namer -> TypeRef snm -> Q Type -typeRefToType Namer -tNamer (THRef (LitT (StrTyLit [Char] -s))) +typeRefToType Namer +tNamer (THRef (LitT (StrTyLit [Char] +s))) = Type -> Q Type forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> Q Type) -> Type -> Q Type @@ -547,15 +547,15 @@ forall a b. (a -> b) -> a -> b forall a b. (a -> b) -> a -> b $ Namer -> Namer completeName Namer -tNamer [Char] -s) -typeRefToType Namer -_tNamer (THRef Type -ty) +tNamer [Char] +s) +typeRefToType Namer +_tNamer (THRef Type +ty) = Type -> Q Type forall (f :: * -> *) a. Applicative f => a -> f a pure Type -ty +ty typeRefToType Namer _ TypeRef snm _ = [Char] -> Q Type @@ -565,13 +565,13 @@ forall a. HasCallStack => [Char] -> a completeName :: Namer -> String -> String completeName :: Namer -> Namer -completeName Namer -namer [Char] -name = Namer +completeName Namer +namer [Char] +name = Namer firstUpper (Namer -namer (Namer +namer (Namer firstUpper [Char] -name)) +name)) firstUpper :: String -> String firstUpper :: Namer @@ -579,14 +579,14 @@ forall a. HasCallStack => [Char] -> a forall a. HasCallStack => [Char] -> a error [Char] "Empty names are not allowed" -firstUpper (Char -x:[Char] -rest) = Char -> Char +firstUpper (Char +x:[Char] +rest) = Char -> Char toUpper Char -x Char -> Namer +x Char -> Namer forall a. a -> [a] -> [a] : [Char] -rest +rest firstLower :: String -> String firstLower :: Namer @@ -594,46 +594,46 @@ forall a. a -> [a] -> [a] forall a. HasCallStack => [Char] -> a error [Char] "Empty names are not allowed" -firstLower (Char -x:[Char] -rest) = Char -> Char +firstLower (Char +x:[Char] +rest) = Char -> Char toLower Char -x Char -> Namer +x Char -> Namer forall a. a -> [a] -> [a] : [Char] -rest +rest -- Parsing -- ======= -typeToServiceDef :: Type -> Q (Maybe (Service String String String (TypeRef snm))) +typeToServiceDef :: Type -> Q (Maybe (Service String String String (TypeRef snm))) typeToServiceDef :: Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef snm))) -typeToServiceDef Type -toplevelty +typeToServiceDef Type +toplevelty = Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm)) forall snm. Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm)) -typeToServiceDef' (Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm))) +typeToServiceDef' (Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm))) -> Q Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef snm))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Q Type resolveTypeSynonyms Type -toplevelty +toplevelty where - typeToServiceDef' :: Type -> Maybe (Service String String String (TypeRef snm)) - typeToServiceDef' :: Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm)) -typeToServiceDef' Type -expanded - = do (Type -sn, Type -_, Type -methods) <- Name -> Type -> Maybe (Type, Type, Type) + typeToServiceDef' :: Type -> Maybe (Service String String String (TypeRef snm)) + typeToServiceDef' :: Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm)) +typeToServiceDef' Type +expanded + = do (Type +sn, Type +_, Type +methods) <- Name -> Type -> Maybe (Type, Type, Type) tyD3 'Service Type -expanded - [Type] -methods' <- Type -> Maybe [Type] +expanded + [Type] +methods' <- Type -> Maybe [Type] tyList Type -methods +methods [Char] -> [Method [Char] [Char] [Char] (TypeRef snm)] -> Service [Char] [Char] [Char] (TypeRef snm) @@ -651,7 +651,7 @@ serviceName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe [Char] tyString Type -sn +sn Maybe ([Method [Char] [Char] [Char] (TypeRef snm)] -> Service [Char] [Char] [Char] (TypeRef snm)) @@ -666,24 +666,24 @@ forall (t :: * -> *) (m :: * -> *) a b. mapM Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm)) forall snm. Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm)) -typeToMethodDef [Type] -methods' +typeToMethodDef [Type] +methods' - typeToMethodDef :: Type -> Maybe (Method String String String (TypeRef snm)) - typeToMethodDef :: Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm)) -typeToMethodDef Type -ty - = do (Type -mn, Type -_, Type -args, Type -ret) <- Name -> Type -> Maybe (Type, Type, Type, Type) + typeToMethodDef :: Type -> Maybe (Method String String String (TypeRef snm)) + typeToMethodDef :: Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm)) +typeToMethodDef Type +ty + = do (Type +mn, Type +_, Type +args, Type +ret) <- Name -> Type -> Maybe (Type, Type, Type, Type) tyD4 'Method Type -ty - [Type] -args' <- Type -> Maybe [Type] +ty + [Type] +args' <- Type -> Maybe [Type] tyList Type -args +args [Char] -> [Argument [Char] [Char] (TypeRef snm)] -> Return [Char] (TypeRef snm) @@ -705,7 +705,7 @@ methodName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe [Char] tyString Type -mn +mn Maybe ([Argument [Char] [Char] (TypeRef snm)] -> Return [Char] (TypeRef snm) @@ -722,8 +722,8 @@ forall (t :: * -> *) (m :: * -> *) a b. (a -> m b) -> t a -> m (t b) mapM Type -> Maybe (Argument [Char] [Char] (TypeRef snm)) forall snm. Type -> Maybe (Argument [Char] [Char] (TypeRef snm)) -typeToArgDef [Type] -args' +typeToArgDef [Type] +args' Maybe (Return [Char] (TypeRef snm) -> Method [Char] [Char] [Char] (TypeRef snm)) @@ -732,19 +732,19 @@ forall snm. Type -> Maybe (Argument [Char] [Char] (TypeRef snm)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Type -> Maybe (Return [Char] (TypeRef snm)) forall snm. Type -> Maybe (Return [Char] (TypeRef snm)) -typeToRetDef Type -ret +typeToRetDef Type +ret - typeToArgDef :: Type -> Maybe (Argument String String (TypeRef snm)) - typeToArgDef :: Type -> Maybe (Argument [Char] [Char] (TypeRef snm)) -typeToArgDef Type -ty - = (do (Type -n, Type -_, Type -t) <- Name -> Type -> Maybe (Type, Type, Type) + typeToArgDef :: Type -> Maybe (Argument String String (TypeRef snm)) + typeToArgDef :: Type -> Maybe (Argument [Char] [Char] (TypeRef snm)) +typeToArgDef Type +ty + = (do (Type +n, Type +_, Type +t) <- Name -> Type -> Maybe (Type, Type, Type) tyD3 'ArgSingle Type -ty +ty Maybe [Char] -> TypeRef snm -> Argument [Char] [Char] (TypeRef snm) forall k argName tyRef (serviceName :: k). Maybe argName -> tyRef -> Argument serviceName argName tyRef @@ -755,24 +755,24 @@ Maybe argName -> tyRef -> Argument serviceName argName tyRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe (Maybe [Char]) tyMaybeString Type -n Maybe (TypeRef snm -> Argument [Char] [Char] (TypeRef snm)) +n Maybe (TypeRef snm -> Argument [Char] [Char] (TypeRef snm)) -> Maybe (TypeRef snm) -> Maybe (Argument [Char] [Char] (TypeRef snm)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Type -> Maybe (TypeRef snm) forall snm. Type -> Maybe (TypeRef snm) -typeToTypeRef Type -t) +typeToTypeRef Type +t) Maybe (Argument [Char] [Char] (TypeRef snm)) -> Maybe (Argument [Char] [Char] (TypeRef snm)) -> Maybe (Argument [Char] [Char] (TypeRef snm)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a -<|> (do (Type -n, Type -_, Type -t) <- Name -> Type -> Maybe (Type, Type, Type) +<|> (do (Type +n, Type +_, Type +t) <- Name -> Type -> Maybe (Type, Type, Type) tyD3 'ArgStream Type -ty +ty Maybe [Char] -> TypeRef snm -> Argument [Char] [Char] (TypeRef snm) forall k argName tyRef (serviceName :: k). Maybe argName -> tyRef -> Argument serviceName argName tyRef @@ -783,19 +783,19 @@ Maybe argName -> tyRef -> Argument serviceName argName tyRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe (Maybe [Char]) tyMaybeString Type -n Maybe (TypeRef snm -> Argument [Char] [Char] (TypeRef snm)) +n Maybe (TypeRef snm -> Argument [Char] [Char] (TypeRef snm)) -> Maybe (TypeRef snm) -> Maybe (Argument [Char] [Char] (TypeRef snm)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Type -> Maybe (TypeRef snm) forall snm. Type -> Maybe (TypeRef snm) -typeToTypeRef Type -t) +typeToTypeRef Type +t) - typeToRetDef :: Type -> Maybe (Return String (TypeRef snm)) - typeToRetDef :: Type -> Maybe (Return [Char] (TypeRef snm)) -typeToRetDef Type -ty + typeToRetDef :: Type -> Maybe (Return String (TypeRef snm)) + typeToRetDef :: Type -> Maybe (Return [Char] (TypeRef snm)) +typeToRetDef Type +ty = Return [Char] (TypeRef snm) forall k (serviceName :: k) tyRef. Return serviceName tyRef RetNothing Return [Char] (TypeRef snm) @@ -803,7 +803,7 @@ forall k (serviceName :: k) tyRef. Return serviceName tyRef forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Name -> Type -> Maybe () tyD0 'RetNothing Type -ty +ty Maybe (Return [Char] (TypeRef snm)) -> Maybe (Return [Char] (TypeRef snm)) -> Maybe (Return [Char] (TypeRef snm)) @@ -816,20 +816,20 @@ tyRef -> Return serviceName tyRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Name -> Type -> Maybe Type tyD1 'RetSingle Type -ty Maybe Type -> (Type -> Maybe (TypeRef snm)) -> Maybe (TypeRef snm) +ty Maybe Type -> (Type -> Maybe (TypeRef snm)) -> Maybe (TypeRef snm) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Type -> Maybe (TypeRef snm) forall snm. Type -> Maybe (TypeRef snm) -typeToTypeRef) +typeToTypeRef) Maybe (Return [Char] (TypeRef snm)) -> Maybe (Return [Char] (TypeRef snm)) -> Maybe (Return [Char] (TypeRef snm)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a -<|> (do (Type -e, Type -v) <- Name -> Type -> Maybe (Type, Type) +<|> (do (Type +e, Type +v) <- Name -> Type -> Maybe (Type, Type) tyD2 'RetThrows Type -ty +ty TypeRef snm -> TypeRef snm -> Return [Char] (TypeRef snm) forall k tyRef (serviceName :: k). tyRef -> tyRef -> Return serviceName tyRef @@ -839,14 +839,14 @@ tyRef -> tyRef -> Return serviceName tyRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe (TypeRef snm) forall snm. Type -> Maybe (TypeRef snm) -typeToTypeRef Type -e Maybe (TypeRef snm -> Return [Char] (TypeRef snm)) +typeToTypeRef Type +e Maybe (TypeRef snm -> Return [Char] (TypeRef snm)) -> Maybe (TypeRef snm) -> Maybe (Return [Char] (TypeRef snm)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Type -> Maybe (TypeRef snm) forall snm. Type -> Maybe (TypeRef snm) -typeToTypeRef Type -v) +typeToTypeRef Type +v) Maybe (Return [Char] (TypeRef snm)) -> Maybe (Return [Char] (TypeRef snm)) -> Maybe (Return [Char] (TypeRef snm)) @@ -859,48 +859,48 @@ tyRef -> Return serviceName tyRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Name -> Type -> Maybe Type tyD1 'RetStream Type -ty Maybe Type -> (Type -> Maybe (TypeRef snm)) -> Maybe (TypeRef snm) +ty Maybe Type -> (Type -> Maybe (TypeRef snm)) -> Maybe (TypeRef snm) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Type -> Maybe (TypeRef snm) forall snm. Type -> Maybe (TypeRef snm) -typeToTypeRef) +typeToTypeRef) - typeToTypeRef :: Type -> Maybe (TypeRef snm) - typeToTypeRef :: Type -> Maybe (TypeRef snm) -typeToTypeRef Type -ty + typeToTypeRef :: Type -> Maybe (TypeRef snm) + typeToTypeRef :: Type -> Maybe (TypeRef snm) +typeToTypeRef Type +ty = (do (Type -_,Type -innerTy) <- Name -> Type -> Maybe (Type, Type) +_,Type +innerTy) <- Name -> Type -> Maybe (Type, Type) tyD2 'SchemaRef Type -ty +ty TypeRef snm -> Maybe (TypeRef snm) forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> TypeRef snm forall serviceName. Type -> TypeRef serviceName THRef Type -innerTy)) +innerTy)) Maybe (TypeRef snm) -> Maybe (TypeRef snm) -> Maybe (TypeRef snm) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (do (Type -_,Type -innerTy,Type +_,Type +innerTy,Type _) <- Name -> Type -> Maybe (Type, Type, Type) tyD3 'RegistryRef Type -ty +ty TypeRef snm -> Maybe (TypeRef snm) forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> TypeRef snm forall serviceName. Type -> TypeRef serviceName THRef Type -innerTy)) +innerTy)) tyMaybeString :: Type -> Maybe (Maybe String) tyMaybeString :: Type -> Maybe (Maybe [Char]) -tyMaybeString (PromotedT Name -c) +tyMaybeString (PromotedT Name +c) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == 'Nothing = Maybe [Char] -> Maybe (Maybe [Char]) @@ -908,11 +908,11 @@ forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe [Char] forall a. Maybe a Nothing -tyMaybeString (AppT (PromotedT Name -c) Type -r) +tyMaybeString (AppT (PromotedT Name +c) Type +r) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == 'Just = [Char] -> Maybe [Char] @@ -921,7 +921,7 @@ forall a. a -> Maybe a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe [Char] tyString Type -r +r tyMaybeString Type _ = Maybe (Maybe [Char]) @@ -930,18 +930,18 @@ forall a. Maybe a tyString :: Type -> Maybe String tyString :: Type -> Maybe [Char] -tyString (SigT Type -t Type +tyString (SigT Type +t Type _) = Type -> Maybe [Char] tyString Type -t -tyString (LitT (StrTyLit [Char] -s)) +t +tyString (LitT (StrTyLit [Char] +s)) = [Char] -> Maybe [Char] forall a. a -> Maybe a Just [Char] -s +s tyString Type _ = Maybe [Char] @@ -950,29 +950,29 @@ forall a. Maybe a tyList :: Type -> Maybe [Type] tyList :: Type -> Maybe [Type] -tyList (SigT Type -t Type +tyList (SigT Type +t Type _) = Type -> Maybe [Type] tyList Type -t +t tyList Type PromotedNilT = [Type] -> Maybe [Type] forall a. a -> Maybe a Just [] tyList (AppT (AppT Type -PromotedConsT Type -ty) Type -rest) +PromotedConsT Type +ty) Type +rest) = (Type -ty Type -> [Type] -> [Type] +ty Type -> [Type] -> [Type] forall a. a -> [a] -> [a] :) ([Type] -> [Type]) -> Maybe [Type] -> Maybe [Type] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Type -> Maybe [Type] tyList Type -rest +rest tyList Type _ = Maybe [Type] forall a. Maybe a @@ -980,21 +980,21 @@ forall a. Maybe a tyD0 :: Name -> Type -> Maybe () tyD0 :: Name -> Type -> Maybe () -tyD0 Name -name (SigT Type -t Type +tyD0 Name +name (SigT Type +t Type _) = Name -> Type -> Maybe () tyD0 Name -name Type -t -tyD0 Name -name (PromotedT Name -c) +name Type +t +tyD0 Name +name (PromotedT Name +c) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name -name = () -> Maybe () +name = () -> Maybe () forall a. a -> Maybe a Just () | Bool @@ -1009,25 +1009,25 @@ forall a. Maybe a tyD1 :: Name -> Type -> Maybe Type tyD1 :: Name -> Type -> Maybe Type -tyD1 Name -name (SigT Type -t Type +tyD1 Name +name (SigT Type +t Type _) = Name -> Type -> Maybe Type tyD1 Name -name Type -t -tyD1 Name -name (AppT (PromotedT Name -c) Type -x) +name Type +t +tyD1 Name +name (AppT (PromotedT Name +c) Type +x) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name -name = Type -> Maybe Type +name = Type -> Maybe Type forall a. a -> Maybe a Just Type -x +x | Bool otherwise = Maybe Type forall a. Maybe a @@ -1040,27 +1040,27 @@ forall a. Maybe a tyD2 :: Name -> Type -> Maybe (Type, Type) tyD2 :: Name -> Type -> Maybe (Type, Type) -tyD2 Name -name (SigT Type -t Type +tyD2 Name +name (SigT Type +t Type _) = Name -> Type -> Maybe (Type, Type) tyD2 Name -name Type -t -tyD2 Name -name (AppT (AppT (PromotedT Name -c) Type -x) Type -y) +name Type +t +tyD2 Name +name (AppT (AppT (PromotedT Name +c) Type +x) Type +y) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name -name = (Type, Type) -> Maybe (Type, Type) +name = (Type, Type) -> Maybe (Type, Type) forall a. a -> Maybe a Just (Type -x, Type -y) +x, Type +y) | Bool otherwise = Maybe (Type, Type) forall a. Maybe a @@ -1073,29 +1073,29 @@ forall a. Maybe a tyD3 :: Name -> Type -> Maybe (Type, Type, Type) tyD3 :: Name -> Type -> Maybe (Type, Type, Type) -tyD3 Name -name (SigT Type -t Type +tyD3 Name +name (SigT Type +t Type _) = Name -> Type -> Maybe (Type, Type, Type) tyD3 Name -name Type -t -tyD3 Name -name (AppT (AppT (AppT (PromotedT Name -c) Type -x) Type -y) Type -z) +name Type +t +tyD3 Name +name (AppT (AppT (AppT (PromotedT Name +c) Type +x) Type +y) Type +z) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name -name = (Type, Type, Type) -> Maybe (Type, Type, Type) +name = (Type, Type, Type) -> Maybe (Type, Type, Type) forall a. a -> Maybe a Just (Type -x, Type -y, Type -z) +x, Type +y, Type +z) | Bool otherwise = Maybe (Type, Type, Type) forall a. Maybe a @@ -1108,31 +1108,31 @@ forall a. Maybe a tyD4 :: Name -> Type -> Maybe (Type, Type, Type, Type) tyD4 :: Name -> Type -> Maybe (Type, Type, Type, Type) -tyD4 Name -name (SigT Type -t Type +tyD4 Name +name (SigT Type +t Type _) = Name -> Type -> Maybe (Type, Type, Type, Type) tyD4 Name -name Type -t -tyD4 Name -name (AppT (AppT (AppT (AppT (PromotedT Name -c) Type -x) Type -y) Type -z) Type -u) +name Type +t +tyD4 Name +name (AppT (AppT (AppT (AppT (PromotedT Name +c) Type +x) Type +y) Type +z) Type +u) | Name -c Name -> Name -> Bool +c Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name -name = (Type, Type, Type, Type) -> Maybe (Type, Type, Type, Type) +name = (Type, Type, Type, Type) -> Maybe (Type, Type, Type, Type) forall a. a -> Maybe a Just (Type -x, Type -y, Type -z, Type -u) +x, Type +y, Type +z, Type +u) | Bool otherwise = Maybe (Type, Type, Type, Type) forall a. Maybe a diff --git a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.TyApps.html b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.TyApps.html index 4af53b0..31a1db2 100644 --- a/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.TyApps.html +++ b/wip/haddock/mu-grpc-client/src/Mu.GRpc.Client.TyApps.html @@ -47,13 +47,13 @@ consult the <http://hackage.haskell.org/package/http2-client-grpc http2-clien -- * The resulting value is always wrapped in 'GRpcReply'. -- * A single input or output turns into a single value. -- * A streaming input or output turns into a Conduit. -gRpcCall :: forall (pro :: GRpcMessageProtocol) (pkg :: Package') - (srvName :: Symbol) (methodName :: Symbol) h - pkgName services methods. - ( pkg ~  'Package ('Just pkgName) services - , LookupService services srvName ~ 'Service srvName methods - , GRpcServiceMethodCall pro pkgName srvName (LookupMethod methods methodName) h) - => GrpcClient -> h +gRpcCall :: forall (pro :: GRpcMessageProtocol) (pkg :: Package') + (srvName :: Symbol) (methodName :: Symbol) h + pkgName services methods. + ( pkg ~  'Package ('Just pkgName) services + , LookupService services srvName ~ 'Service srvName methods + , GRpcServiceMethodCall pro pkgName srvName (LookupMethod methods methodName) h) + => GrpcClient -> h gRpcCall :: GrpcClient -> h gRpcCall = Proxy pro @@ -68,12 +68,12 @@ GRpcServiceMethodCall p pkg s m h => Proxy p -> Proxy pkg -> Proxy s -> Proxy m -> GrpcClient -> h gRpcServiceMethodCall (Proxy pro forall k (t :: k). Proxy t -Proxy @pro) (Proxy pkgName +Proxy @pro) (Proxy pkgName forall k (t :: k). Proxy t -Proxy @pkgName) (Proxy srvName +Proxy @pkgName) (Proxy srvName forall k (t :: k). Proxy t -Proxy @srvName) +Proxy @srvName) (Proxy (LookupMethod methods methodName) forall k (t :: k). Proxy t -Proxy @(LookupMethod methods methodName)) +Proxy @(LookupMethod methods methodName)) \ No newline at end of file diff --git a/wip/haddock/mu-grpc-common/mu-grpc-common.haddock b/wip/haddock/mu-grpc-common/mu-grpc-common.haddock index 2fd8771..79f4b48 100644 Binary files a/wip/haddock/mu-grpc-common/mu-grpc-common.haddock and b/wip/haddock/mu-grpc-common/mu-grpc-common.haddock differ diff --git a/wip/haddock/mu-grpc-server/mu-grpc-server.haddock b/wip/haddock/mu-grpc-server/mu-grpc-server.haddock index 1960856..156ffa2 100644 Binary files a/wip/haddock/mu-grpc-server/mu-grpc-server.haddock and b/wip/haddock/mu-grpc-server/mu-grpc-server.haddock differ diff --git a/wip/haddock/mu-grpc-server/src/Mu.GRpc.Server.html b/wip/haddock/mu-grpc-server/src/Mu.GRpc.Server.html index c0f53f0..e5bdbc5 100644 --- a/wip/haddock/mu-grpc-server/src/Mu.GRpc.Server.html +++ b/wip/haddock/mu-grpc-server/src/Mu.GRpc.Server.html @@ -66,22 +66,22 @@ variants provide more control over the settings. import Mu.Server -- | Run a Mu 'Server' on the given port. -runGRpcApp - :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol ServerErrorIO chn services handlers ) - => Proxy protocol +runGRpcApp + :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol ServerErrorIO chn services handlers ) + => Proxy protocol -> Port - -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers + -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers -> IO () runGRpcApp :: Proxy protocol -> Port -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers -> IO () -runGRpcApp Proxy protocol -protocol Port -port = Proxy protocol +runGRpcApp Proxy protocol +protocol Port +port = Proxy protocol -> Port -> (forall a. ServerErrorIO a -> ServerErrorIO a) -> ServerT @@ -105,33 +105,33 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () runGRpcAppTrans Proxy protocol -protocol Port -port forall a. a -> a +protocol Port +port forall a. a -> a forall a. ServerErrorIO a -> ServerErrorIO a id -- | Run a Mu 'Server' on the given port. -runGRpcAppTrans - :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol m chn services handlers ) - => Proxy protocol +runGRpcAppTrans + :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol m chn services handlers ) + => Proxy protocol -> Port - -> (forall a. m a -> ServerErrorIO a) - -> ServerT chn () ('Package ('Just name) services) m handlers + -> (forall a. m a -> ServerErrorIO a) + -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () runGRpcAppTrans :: Proxy protocol -> Port -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () -runGRpcAppTrans Proxy protocol -protocol Port -port forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr = Port -> Application -> IO () +runGRpcAppTrans Proxy protocol +protocol Port +port forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr = Port -> Application -> IO () run Port -port (Proxy protocol +port (Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> Application @@ -152,34 +152,34 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> Application gRpcAppTrans Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr) +protocol forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr) -- | Run a Mu 'Server' using the given 'Settings'. -- -- Go to 'Network.Wai.Handler.Warp' to declare 'Settings'. -runGRpcAppSettings - :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol m chn services handlers ) - => Proxy protocol +runGRpcAppSettings + :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol m chn services handlers ) + => Proxy protocol -> Settings - -> (forall a. m a -> ServerErrorIO a) - -> ServerT chn () ('Package ('Just name) services) m handlers + -> (forall a. m a -> ServerErrorIO a) + -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () runGRpcAppSettings :: Proxy protocol -> Settings -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () -runGRpcAppSettings Proxy protocol -protocol Settings -st forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr = Settings -> Application -> IO () +runGRpcAppSettings Proxy protocol +protocol Settings +st forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr = Settings -> Application -> IO () runSettings Settings -st (Proxy protocol +st (Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> Application @@ -200,22 +200,22 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> Application gRpcAppTrans Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr) +protocol forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr) -- | Run a Mu 'Server' using the given 'TLSSettings' and 'Settings'. -- -- Go to 'Network.Wai.Handler.WarpTLS' to declare 'TLSSettings' -- and to 'Network.Wai.Handler.Warp' to declare 'Settings'. -runGRpcAppTLS - :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol m chn services handlers ) - => Proxy protocol +runGRpcAppTLS + :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol m chn services handlers ) + => Proxy protocol -> TLSSettings -> Settings - -> (forall a. m a -> ServerErrorIO a) - -> ServerT chn () ('Package ('Just name) services) m handlers + -> (forall a. m a -> ServerErrorIO a) + -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () runGRpcAppTLS :: Proxy protocol -> TLSSettings @@ -223,15 +223,15 @@ Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> IO () -runGRpcAppTLS Proxy protocol -protocol TLSSettings -tls Settings -st forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr = TLSSettings -> Settings -> Application -> IO () +runGRpcAppTLS Proxy protocol +protocol TLSSettings +tls Settings +st forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr = TLSSettings -> Settings -> Application -> IO () runTLS TLSSettings -tls Settings -st (Proxy protocol +tls Settings +st (Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> Application @@ -252,28 +252,28 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> Application gRpcAppTrans Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr) +protocol forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr) -- | Turn a Mu 'Server' into a WAI 'Application'. -- -- These 'Application's can be later combined using, -- for example, @wai-routes@, or you can add middleware -- from @wai-extra@, among others. -gRpcApp - :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol ServerErrorIO chn services handlers ) - => Proxy protocol - -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers +gRpcApp + :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol ServerErrorIO chn services handlers ) + => Proxy protocol + -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers -> Application gRpcApp :: Proxy protocol -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers -> Application -gRpcApp Proxy protocol -protocol = Proxy protocol +gRpcApp Proxy protocol +protocol = Proxy protocol -> (forall a. ServerErrorIO a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers @@ -295,7 +295,7 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> Application gRpcAppTrans Proxy protocol -protocol forall a. a -> a +protocol forall a. a -> a forall a. ServerErrorIO a -> ServerErrorIO a id @@ -304,22 +304,22 @@ forall a. ServerErrorIO a -> ServerErrorIO a -- These 'Application's can be later combined using, -- for example, @wai-routes@, or you can add middleware -- from @wai-extra@, among others. -gRpcAppTrans - :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol m chn services handlers ) - => Proxy protocol - -> (forall a. m a -> ServerErrorIO a) - -> ServerT chn () ('Package ('Just name) services) m handlers +gRpcAppTrans + :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol m chn services handlers ) + => Proxy protocol + -> (forall a. m a -> ServerErrorIO a) + -> ServerT chn () ('Package ('Just name) services) m handlers -> Application gRpcAppTrans :: Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> Application -gRpcAppTrans Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr +gRpcAppTrans Proxy protocol +protocol forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr = [Compression] -> [ServiceHandler] -> Application Wai.grpcApp [Compression uncompressed, Compression @@ -345,23 +345,23 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> [ServiceHandler] gRpcServerHandlers Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr) +protocol forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr) -- | Turn several Mu 'Server's into a WAI 'Application'. -- -- These 'Application's can be later combined using, -- for example, @wai-routes@, or you can add middleware -- from @wai-extra@, among others. -gRpcMultipleApp - :: Proxy protocol - -> [WrappedServer protocol ServerErrorIO] +gRpcMultipleApp + :: Proxy protocol + -> [WrappedServer protocol ServerErrorIO] -> Application gRpcMultipleApp :: Proxy protocol -> [WrappedServer protocol ServerErrorIO] -> Application -gRpcMultipleApp Proxy protocol -protocol = Proxy protocol +gRpcMultipleApp Proxy protocol +protocol = Proxy protocol -> (forall a. ServerErrorIO a -> ServerErrorIO a) -> [WrappedServer protocol ServerErrorIO] -> Application @@ -371,7 +371,7 @@ Proxy protocol -> [WrappedServer protocol m] -> Application gRpcMultipleAppTrans Proxy protocol -protocol forall a. a -> a +protocol forall a. a -> a forall a. ServerErrorIO a -> ServerErrorIO a id @@ -380,19 +380,19 @@ forall a. ServerErrorIO a -> ServerErrorIO a -- These 'Application's can be later combined using, -- for example, @wai-routes@, or you can add middleware -- from @wai-extra@, among others. -gRpcMultipleAppTrans - :: Proxy protocol - -> (forall a. m a -> ServerErrorIO a) - -> [WrappedServer protocol m] +gRpcMultipleAppTrans + :: Proxy protocol + -> (forall a. m a -> ServerErrorIO a) + -> [WrappedServer protocol m] -> Application gRpcMultipleAppTrans :: Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> [WrappedServer protocol m] -> Application -gRpcMultipleAppTrans Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f [WrappedServer protocol m] -svr +gRpcMultipleAppTrans Proxy protocol +protocol forall a. m a -> ServerErrorIO a +f [WrappedServer protocol m] +svr = [Compression] -> [ServiceHandler] -> Application Wai.grpcApp [Compression uncompressed, Compression @@ -410,27 +410,27 @@ Proxy protocol -> WrappedServer protocol m -> [ServiceHandler] gRpcServerHandlersS Proxy protocol -protocol forall a. m a -> ServerErrorIO a -f) [WrappedServer protocol m] -svr) +protocol forall a. m a -> ServerErrorIO a +f) [WrappedServer protocol m] +svr) gRpcServerHandlers - :: forall name services handlers m protocol chn. - ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol m chn services handlers ) - => Proxy protocol - -> (forall a. m a -> ServerErrorIO a) - -> ServerT chn () ('Package ('Just name) services) m handlers + :: forall name services handlers m protocol chn. + ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol m chn services handlers ) + => Proxy protocol + -> (forall a. m a -> ServerErrorIO a) + -> ServerT chn () ('Package ('Just name) services) m handlers -> [ServiceHandler] gRpcServerHandlers :: Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers -> [ServiceHandler] -gRpcServerHandlers Proxy protocol -pr forall a. m a -> ServerErrorIO a -f (Services ServicesT chn () s1 m handlers -svr) +gRpcServerHandlers Proxy protocol +pr forall a. m a -> ServerErrorIO a +f (Services ServicesT chn () s1 m handlers +svr) = (forall a. m a -> ServerErrorIO a) -> Proxy ('Package ('Just name) services) -> Proxy protocol @@ -448,42 +448,42 @@ GRpcServiceHandlers fullP p m chn ss hs => -> ServicesT chn () ss m hs -> [ServiceHandler] gRpcServiceHandlers forall a. m a -> ServerErrorIO a -f (Proxy ('Package ('Just name) services) +f (Proxy ('Package ('Just name) services) forall k (t :: k). Proxy t -Proxy @('Package ('Just name) services)) Proxy protocol -pr ByteString -packageName ServicesT chn () s1 m handlers -svr - where packageName :: ByteString -packageName = String -> ByteString +Proxy @('Package ('Just name) services)) Proxy protocol +pr ByteString +packageName ServicesT chn () s1 m handlers +svr + where packageName :: ByteString +packageName = String -> ByteString BS.pack (Proxy name -> String forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> String nameVal (Proxy name forall k (t :: k). Proxy t -Proxy @name)) +Proxy @name)) -data WrappedServer protocol m where - Srv :: ( KnownName name - , GRpcServiceHandlers ('Package ('Just name) services) - protocol m chn services handlers ) - => ServerT chn () ('Package ('Just name) services) m handlers - -> WrappedServer protocol m +data WrappedServer protocol m where + Srv :: ( KnownName name + , GRpcServiceHandlers ('Package ('Just name) services) + protocol m chn services handlers ) + => ServerT chn () ('Package ('Just name) services) m handlers + -> WrappedServer protocol m -gRpcServerHandlersS - :: Proxy protocol - -> (forall a. m a -> ServerErrorIO a) - -> WrappedServer protocol m +gRpcServerHandlersS + :: Proxy protocol + -> (forall a. m a -> ServerErrorIO a) + -> WrappedServer protocol m -> [ServiceHandler] gRpcServerHandlersS :: Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> WrappedServer protocol m -> [ServiceHandler] -gRpcServerHandlersS Proxy protocol -pr forall a. m a -> ServerErrorIO a -f (Srv ServerT chn () ('Package ('Just name) services) m handlers -svr) +gRpcServerHandlersS Proxy protocol +pr forall a. m a -> ServerErrorIO a +f (Srv ServerT chn () ('Package ('Just name) services) m handlers +svr) = Proxy protocol -> (forall a. m a -> ServerErrorIO a) -> ServerT chn () ('Package ('Just name) services) m handlers @@ -505,49 +505,49 @@ Proxy protocol -> ServerT chn () ('Package ('Just name) services) m handlers -> [ServiceHandler] gRpcServerHandlers Proxy protocol -pr forall a. m a -> ServerErrorIO a -f ServerT chn () ('Package ('Just name) services) m handlers -svr +pr forall a. m a -> ServerErrorIO a +f ServerT chn () ('Package ('Just name) services) m handlers +svr -class GRpcServiceHandlers (fullP :: Package snm mnm anm (TypeRef snm)) - (p :: GRpcMessageProtocol) (m :: Type -> Type) - (chn :: ServiceChain snm) - (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[Type]]) where - gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) - -> Proxy fullP -> Proxy p -> ByteString - -> ServicesT chn () ss m hs -> [ServiceHandler] +class GRpcServiceHandlers (fullP :: Package snm mnm anm (TypeRef snm)) + (p :: GRpcMessageProtocol) (m :: Type -> Type) + (chn :: ServiceChain snm) + (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[Type]]) where + gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) + -> Proxy fullP -> Proxy p -> ByteString + -> ServicesT chn () ss m hs -> [ServiceHandler] -instance GRpcServiceHandlers fullP p m chn '[] '[] where - gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) +instance GRpcServiceHandlers fullP p m chn '[] '[] where + gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) -> Proxy fullP -> Proxy p -> ByteString -> ServicesT chn () '[] m '[] -> [ServiceHandler] -gRpcServiceHandlers forall a. m a -> ServerErrorIO a +gRpcServiceHandlers forall a. m a -> ServerErrorIO a _ Proxy fullP _ Proxy p _ ByteString _ ServicesT chn () '[] m '[] S0 = [] -instance ( KnownName name - , GRpcMethodHandlers fullP ('Service name methods) - p m chn (MappingRight chn name) methods h - , GRpcServiceHandlers fullP p m chn rest hs ) - => GRpcServiceHandlers fullP p m chn ('Service name methods ': rest) (h ': hs) where - gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) +instance ( KnownName name + , GRpcMethodHandlers fullP ('Service name methods) + p m chn (MappingRight chn name) methods h + , GRpcServiceHandlers fullP p m chn rest hs ) + => GRpcServiceHandlers fullP p m chn ('Service name methods ': rest) (h ': hs) where + gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) -> Proxy fullP -> Proxy p -> ByteString -> ServicesT chn () ('Service name methods : rest) m (h : hs) -> [ServiceHandler] -gRpcServiceHandlers forall a. m a -> ServerErrorIO a -f Proxy fullP -pfullP Proxy p -pr ByteString -packageName (ProperSvc HandlersT chn () (MappingRight chn sname) methods m hs1 -svr :<&>: ServicesT chn () rest m hss -rest) +gRpcServiceHandlers forall a. m a -> ServerErrorIO a +f Proxy fullP +pfullP Proxy p +pr ByteString +packageName (ProperSvc HandlersT chn () (MappingRight chn sname) methods m hs1 +svr :<&>: ServicesT chn () rest m hss +rest) = (forall a. m a -> ServerErrorIO a) -> Proxy fullP -> Proxy ('Service name methods) @@ -570,16 +570,16 @@ GRpcMethodHandlers fullP fullS p m chn inh ms hs => -> HandlersT chn () inh ms m hs -> [ServiceHandler] gRpcMethodHandlers forall a. m a -> ServerErrorIO a -f Proxy fullP -pfullP (Proxy ('Service name methods) +f Proxy fullP +pfullP (Proxy ('Service name methods) forall k (t :: k). Proxy t -Proxy @('Service name methods)) Proxy p -pr +Proxy @('Service name methods)) Proxy p +pr ByteString -packageName ByteString -serviceName HandlersT chn () (MappingRight chn name) methods m hs1 +packageName ByteString +serviceName HandlersT chn () (MappingRight chn name) methods m hs1 HandlersT chn () (MappingRight chn sname) methods m hs1 -svr +svr [ServiceHandler] -> [ServiceHandler] -> [ServiceHandler] forall a. [a] -> [a] -> [a] ++ (forall a. m a -> ServerErrorIO a) @@ -599,30 +599,30 @@ GRpcServiceHandlers fullP p m chn ss hs => -> ServicesT chn () ss m hs -> [ServiceHandler] gRpcServiceHandlers forall a. m a -> ServerErrorIO a -f Proxy fullP -pfullP Proxy p -pr ByteString -packageName ServicesT chn () rest m hss -rest - where serviceName :: ByteString -serviceName = String -> ByteString +f Proxy fullP +pfullP Proxy p +pr ByteString +packageName ServicesT chn () rest m hss +rest + where serviceName :: ByteString +serviceName = String -> ByteString BS.pack (Proxy name -> String forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> String nameVal (Proxy name forall k (t :: k). Proxy t -Proxy @name)) +Proxy @name)) -instance ( GHC.TypeLits.TypeError ('Text "unions are not supported in gRPC") ) - => GRpcServiceHandlers fullP p m chn ('OneOf name methods ': rest) hs where - gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) +instance ( GHC.TypeLits.TypeError ('Text "unions are not supported in gRPC") ) + => GRpcServiceHandlers fullP p m chn ('OneOf name methods ': rest) hs where + gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a) -> Proxy fullP -> Proxy p -> ByteString -> ServicesT chn () ('OneOf name methods : rest) m hs -> [ServiceHandler] -gRpcServiceHandlers forall a. m a -> ServerErrorIO a +gRpcServiceHandlers forall a. m a -> ServerErrorIO a _ = String -> Proxy fullP -> Proxy p @@ -633,17 +633,17 @@ forall a. HasCallStack => String -> a error String "unions are not supported in gRPC" -class GRpcMethodHandlers (fullP :: Package snm mnm anm (TypeRef snm)) - (fullS :: Service snm mnm anm (TypeRef snm)) - (p :: GRpcMessageProtocol) (m :: Type -> Type) - (chn :: ServiceChain snm) (inh :: Type) - (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [Type]) where - gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a) - -> Proxy fullP -> Proxy fullS -> Proxy p -> ByteString -> ByteString - -> HandlersT chn () inh ms m hs -> [ServiceHandler] +class GRpcMethodHandlers (fullP :: Package snm mnm anm (TypeRef snm)) + (fullS :: Service snm mnm anm (TypeRef snm)) + (p :: GRpcMessageProtocol) (m :: Type -> Type) + (chn :: ServiceChain snm) (inh :: Type) + (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [Type]) where + gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a) + -> Proxy fullP -> Proxy fullS -> Proxy p -> ByteString -> ByteString + -> HandlersT chn () inh ms m hs -> [ServiceHandler] -instance GRpcMethodHandlers fullP fullS p m chn inh '[] '[] where - gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a) +instance GRpcMethodHandlers fullP fullS p m chn inh '[] '[] where + gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a) -> Proxy fullP -> Proxy fullS -> Proxy p @@ -651,7 +651,7 @@ forall a. HasCallStack => String -> a -> ByteString -> HandlersT chn () inh '[] m '[] -> [ServiceHandler] -gRpcMethodHandlers forall a. m a -> ServerErrorIO a +gRpcMethodHandlers forall a. m a -> ServerErrorIO a _ Proxy fullP _ Proxy fullS _ Proxy p @@ -659,13 +659,13 @@ forall a. HasCallStack => String -> a _ ByteString _ HandlersT chn () inh '[] m '[] H0 = [] -instance ( KnownName name, MkRPC p - , ReflectRpcInfo fullP fullS ('Method name args r) - , GRpcMethodHandler p m args r h - , GRpcMethodHandlers fullP fullS p m chn () rest hs) - => GRpcMethodHandlers fullP fullS p m chn () - ('Method name args r ': rest) (h ': hs) where - gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a) +instance ( KnownName name, MkRPC p + , ReflectRpcInfo fullP fullS ('Method name args r) + , GRpcMethodHandler p m args r h + , GRpcMethodHandlers fullP fullS p m chn () rest hs) + => GRpcMethodHandlers fullP fullS p m chn () + ('Method name args r ': rest) (h ': hs) where + gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a) -> Proxy fullP -> Proxy fullS -> Proxy p @@ -673,17 +673,17 @@ forall a. HasCallStack => String -> a -> ByteString -> HandlersT chn () () ('Method name args r : rest) m (h : hs) -> [ServiceHandler] -gRpcMethodHandlers forall a. m a -> ServerErrorIO a -f Proxy fullP -pfullP Proxy fullS -pfullS Proxy p -pr ByteString -p ByteString -s (Hmore Proxy args +gRpcMethodHandlers forall a. m a -> ServerErrorIO a +f Proxy fullP +pfullP Proxy fullS +pfullS Proxy p +pr ByteString +p ByteString +s (Hmore Proxy args _ Proxy ret -_ RpcInfo () -> () -> h -h HandlersT chn () () ms m hs1 -rest) +_ RpcInfo () -> () -> h +h HandlersT chn () () ms m hs1 +rest) = (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy args @@ -702,26 +702,26 @@ GRpcMethodHandler p m args r h => -> (Request -> h) -> ServiceHandler gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p -pr (Proxy args +f Proxy p +pr (Proxy args forall k (t :: k). Proxy t -Proxy @args) (Proxy r +Proxy @args) (Proxy r forall k (t :: k). Proxy t -Proxy @r) (Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p +Proxy @r) (Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p forall (p :: GRpcMessageProtocol). MkRPC p => Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p mkRPC Proxy p -pr ByteString -p ByteString -s ByteString -methodName) - (\Request -req -> RpcInfo () -> () -> h -h (RequestHeaders -> RpcInfo () -reflectInfo (Request -> RequestHeaders +pr ByteString +p ByteString +s ByteString +methodName) + (\Request +req -> RpcInfo () -> () -> h +h (RequestHeaders -> RpcInfo () +reflectInfo (Request -> RequestHeaders requestHeaders Request -req)) ()) +req)) ()) ServiceHandler -> [ServiceHandler] -> [ServiceHandler] forall a. a -> [a] -> [a] : (forall a. m a -> ServerErrorIO a) @@ -746,25 +746,25 @@ GRpcMethodHandlers fullP fullS p m chn inh ms hs => -> HandlersT chn () inh ms m hs -> [ServiceHandler] gRpcMethodHandlers forall a. m a -> ServerErrorIO a -f Proxy fullP -pfullP Proxy fullS -pfullS Proxy p -pr ByteString -p ByteString -s HandlersT chn () () ms m hs1 -rest - where methodName :: ByteString -methodName = String -> ByteString +f Proxy fullP +pfullP Proxy fullS +pfullS Proxy p +pr ByteString +p ByteString +s HandlersT chn () () ms m hs1 +rest + where methodName :: ByteString +methodName = String -> ByteString BS.pack (Proxy name -> String forall k (a :: k) (proxy :: k -> *). KnownName a => proxy a -> String nameVal (Proxy name forall k (t :: k). Proxy t -Proxy @name)) - reflectInfo :: RequestHeaders -> RpcInfo () -reflectInfo RequestHeaders -hdrs +Proxy @name)) + reflectInfo :: RequestHeaders -> RpcInfo () +reflectInfo RequestHeaders +hdrs = Proxy fullP -> Proxy fullS -> Proxy ('Method name args r) @@ -777,16 +777,16 @@ forall (p :: Package Symbol Symbol Symbol (TypeRef Symbol)) ReflectRpcInfo p s m => Proxy p -> Proxy s -> Proxy m -> RequestHeaders -> i -> RpcInfo i reflectRpcInfo Proxy fullP -pfullP Proxy fullS -pfullS (Proxy ('Method name args r) +pfullP Proxy fullS +pfullS (Proxy ('Method name args r) forall k (t :: k). Proxy t -Proxy @('Method name args r)) RequestHeaders -hdrs () +Proxy @('Method name args r)) RequestHeaders +hdrs () -class GRpcMethodHandler p m (args :: [Argument snm anm (TypeRef snm)]) r h where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) - -> Proxy p -> Proxy args -> Proxy r - -> RPCTy p -> (Request -> h) -> ServiceHandler +class GRpcMethodHandler p m (args :: [Argument snm anm (TypeRef snm)]) r h where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) + -> Proxy p -> Proxy args -> Proxy r + -> RPCTy p -> (Request -> h) -> ServiceHandler -- | Turns a 'Conduit' working on 'ServerErrorIO' -- into any other base monad which supports 'IO', @@ -795,9 +795,9 @@ forall k (t :: k). Proxy t -- This function is useful to interoperate with -- libraries which generate 'Conduit's with other -- base monads, such as @persistent@. -liftServerConduit - :: MonadIO m - => ConduitT a b ServerErrorIO r -> ConduitT a b m r +liftServerConduit + :: MonadIO m + => ConduitT a b ServerErrorIO r -> ConduitT a b m r liftServerConduit :: ConduitT a b ServerErrorIO r -> ConduitT a b m r liftServerConduit = (forall a. ServerErrorIO a -> m a) -> ConduitT a b ServerErrorIO r -> ConduitT a b m r @@ -815,55 +815,55 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a -- libraries which cannot handle the additional error -- layer. In particular, with Conduit, as witnessed -- by 'liftServerConduit'. -raiseErrors :: MonadIO m => ServerErrorIO a -> m a +raiseErrors :: MonadIO m => ServerErrorIO a -> m a raiseErrors :: ServerErrorIO a -> m a -raiseErrors ServerErrorIO a -h +raiseErrors ServerErrorIO a +h = IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO a -> m a) -> IO a -> m a forall a b. (a -> b) -> a -> b $ do - Either ServerError a -h' <- ServerErrorIO a -> IO (Either ServerError a) + Either ServerError a +h' <- ServerErrorIO a -> IO (Either ServerError a) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT ServerErrorIO a -h +h case Either ServerError a -h' of - Right a -r -> a -> IO a +h' of + Right a +r -> a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure a -r - Left (ServerError ServerErrorCode -code String -msg) +r + Left (ServerError ServerErrorCode +code String +msg) -> GRPCStatus -> IO a forall (m :: * -> *) a. MonadIO m => GRPCStatus -> m a closeEarly (GRPCStatus -> IO a) -> GRPCStatus -> IO a forall a b. (a -> b) -> a -> b $ GRPCStatusCode -> ByteString -> GRPCStatus GRPCStatus (ServerErrorCode -> GRPCStatusCode -serverErrorToGRpcError ServerErrorCode -code) +serverErrorToGRpcError ServerErrorCode +code) (String -> ByteString BS.pack String -msg) +msg) IO a -> [Handler a] -> IO a forall a. IO a -> [Handler a] -> IO a `catches` [ (GRPCStatus -> IO a) -> Handler a forall a e. Exception e => (e -> IO a) -> Handler a -Handler (\(GRPCStatus -e :: GRPCStatus) -> GRPCStatus -> IO a +Handler (\(GRPCStatus +e :: GRPCStatus) -> GRPCStatus -> IO a forall e a. Exception e => e -> IO a throwIO GRPCStatus -e) +e) , (SomeException -> IO a) -> Handler a forall a e. Exception e => (e -> IO a) -> Handler a -Handler (\(SomeException -e :: SomeException) -> GRPCStatus -> IO a +Handler (\(SomeException +e :: SomeException) -> GRPCStatus -> IO a forall (m :: * -> *) a. MonadIO m => GRPCStatus -> m a closeEarly (GRPCStatus -> IO a) -> GRPCStatus -> IO a forall a b. (a -> b) -> a -> b @@ -875,31 +875,31 @@ forall a b. (a -> b) -> a -> b $ SomeException -> String forall a. Show a => a -> String show SomeException -e)) +e)) ] where - serverErrorToGRpcError :: ServerErrorCode -> GRPCStatusCode - serverErrorToGRpcError :: ServerErrorCode -> GRPCStatusCode -serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError :: ServerErrorCode -> GRPCStatusCode + serverErrorToGRpcError :: ServerErrorCode -> GRPCStatusCode +serverErrorToGRpcError ServerErrorCode Unknown = GRPCStatusCode UNKNOWN - serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError ServerErrorCode Unavailable = GRPCStatusCode UNAVAILABLE - serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError ServerErrorCode Unimplemented = GRPCStatusCode UNIMPLEMENTED - serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError ServerErrorCode Unauthenticated = GRPCStatusCode UNAUTHENTICATED - serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError ServerErrorCode Internal = GRPCStatusCode INTERNAL - serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError ServerErrorCode NotFound = GRPCStatusCode NOT_FOUND - serverErrorToGRpcError ServerErrorCode + serverErrorToGRpcError ServerErrorCode Invalid = GRPCStatusCode INVALID_ARGUMENT @@ -910,64 +910,64 @@ forall a. Show a => a -> String -- These type classes allow us to abstract over -- the choice of message protocol (PB or Avro) -class GRPCOutput (RPCTy p) (GRpcOWTy p ref r) - => GRpcOutputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where - type GRpcOWTy p ref r :: Type - buildGRpcOWTy :: Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r +class GRPCOutput (RPCTy p) (GRpcOWTy p ref r) + => GRpcOutputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where + type GRpcOWTy p ref r :: Type + buildGRpcOWTy :: Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r -instance ToProtoBufTypeRef ref r - => GRpcOutputWrapper 'MsgProtoBuf ref r where - type GRpcOWTy 'MsgProtoBuf ref r = ViaToProtoBufTypeRef ref r - buildGRpcOWTy :: Proxy 'MsgProtoBuf -> Proxy ref -> r -> GRpcOWTy 'MsgProtoBuf ref r -buildGRpcOWTy Proxy 'MsgProtoBuf +instance ToProtoBufTypeRef ref r + => GRpcOutputWrapper 'MsgProtoBuf ref r where + type GRpcOWTy 'MsgProtoBuf ref r = ViaToProtoBufTypeRef ref r + buildGRpcOWTy :: Proxy 'MsgProtoBuf -> Proxy ref -> r -> GRpcOWTy 'MsgProtoBuf ref r +buildGRpcOWTy Proxy 'MsgProtoBuf _ Proxy ref _ = r -> GRpcOWTy 'MsgProtoBuf ref r forall snm (ref :: TypeRef snm) t. t -> ViaToProtoBufTypeRef ref t ViaToProtoBufTypeRef -instance forall (sch :: Schema') sty (r :: Type). - ( ToSchema sch sty r - , ToAvro (WithSchema sch sty r) - , HasAvroSchema (WithSchema sch sty r) ) - => GRpcOutputWrapper 'MsgAvro ('SchemaRef sch sty) r where - type GRpcOWTy 'MsgAvro ('SchemaRef sch sty) r = ViaToAvroTypeRef ('SchemaRef sch sty) r - buildGRpcOWTy :: Proxy 'MsgAvro +instance forall (sch :: Schema') sty (r :: Type). + ( ToSchema sch sty r + , ToAvro (WithSchema sch sty r) + , HasAvroSchema (WithSchema sch sty r) ) + => GRpcOutputWrapper 'MsgAvro ('SchemaRef sch sty) r where + type GRpcOWTy 'MsgAvro ('SchemaRef sch sty) r = ViaToAvroTypeRef ('SchemaRef sch sty) r + buildGRpcOWTy :: Proxy 'MsgAvro -> Proxy ('SchemaRef sch sty) -> r -> GRpcOWTy 'MsgAvro ('SchemaRef sch sty) r -buildGRpcOWTy Proxy 'MsgAvro +buildGRpcOWTy Proxy 'MsgAvro _ Proxy ('SchemaRef sch sty) _ = r -> GRpcOWTy 'MsgAvro ('SchemaRef sch sty) r forall snm (ref :: TypeRef snm) t. t -> ViaToAvroTypeRef ref t ViaToAvroTypeRef -class GRPCInput (RPCTy p) (GRpcIWTy p ref r) - => GRpcInputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where - type GRpcIWTy p ref r :: Type - unGRpcIWTy :: Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r +class GRPCInput (RPCTy p) (GRpcIWTy p ref r) + => GRpcInputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef snm) (r :: Type) where + type GRpcIWTy p ref r :: Type + unGRpcIWTy :: Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r -instance FromProtoBufTypeRef ref r - => GRpcInputWrapper 'MsgProtoBuf ref r where - type GRpcIWTy 'MsgProtoBuf ref r = ViaFromProtoBufTypeRef ref r - unGRpcIWTy :: Proxy 'MsgProtoBuf -> Proxy ref -> GRpcIWTy 'MsgProtoBuf ref r -> r -unGRpcIWTy Proxy 'MsgProtoBuf +instance FromProtoBufTypeRef ref r + => GRpcInputWrapper 'MsgProtoBuf ref r where + type GRpcIWTy 'MsgProtoBuf ref r = ViaFromProtoBufTypeRef ref r + unGRpcIWTy :: Proxy 'MsgProtoBuf -> Proxy ref -> GRpcIWTy 'MsgProtoBuf ref r -> r +unGRpcIWTy Proxy 'MsgProtoBuf _ Proxy ref _ = GRpcIWTy 'MsgProtoBuf ref r -> r forall snm (ref :: TypeRef snm) t. ViaFromProtoBufTypeRef ref t -> t unViaFromProtoBufTypeRef -instance forall (sch :: Schema') sty (r :: Type). - ( FromSchema sch sty r - , FromAvro (WithSchema sch sty r) - , HasAvroSchema (WithSchema sch sty r) ) - => GRpcInputWrapper 'MsgAvro ('SchemaRef sch sty) r where - type GRpcIWTy 'MsgAvro ('SchemaRef sch sty) r = ViaFromAvroTypeRef ('SchemaRef sch sty) r - unGRpcIWTy :: Proxy 'MsgAvro +instance forall (sch :: Schema') sty (r :: Type). + ( FromSchema sch sty r + , FromAvro (WithSchema sch sty r) + , HasAvroSchema (WithSchema sch sty r) ) + => GRpcInputWrapper 'MsgAvro ('SchemaRef sch sty) r where + type GRpcIWTy 'MsgAvro ('SchemaRef sch sty) r = ViaFromAvroTypeRef ('SchemaRef sch sty) r + unGRpcIWTy :: Proxy 'MsgAvro -> Proxy ('SchemaRef sch sty) -> GRpcIWTy 'MsgAvro ('SchemaRef sch sty) r -> r -unGRpcIWTy Proxy 'MsgAvro +unGRpcIWTy Proxy 'MsgAvro _ Proxy ('SchemaRef sch sty) _ = GRpcIWTy 'MsgAvro ('SchemaRef sch sty) r -> r forall snm (ref :: TypeRef snm) t. ViaFromAvroTypeRef ref t -> t @@ -975,60 +975,60 @@ forall snm (ref :: TypeRef snm) t. ViaFromAvroTypeRef ref t -> t --- -instance (MonadIO m, GRPCInput (RPCTy p) (), GRPCOutput (RPCTy p) ()) - => GRpcMethodHandler p m '[ ] 'RetNothing (m ()) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRPCInput (RPCTy p) (), GRPCOutput (RPCTy p) ()) + => GRpcMethodHandler p m '[ ] 'RetNothing (m ()) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[] -> Proxy 'RetNothing -> RPCTy p -> (Request -> m ()) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[] _ Proxy 'RetNothing -_ RPCTy p -rpc Request -> m () -h +_ RPCTy p +rpc Request -> m () +h = (forall x. m x -> IO x) -> RPCTy p -> UnaryHandler m () () -> ServiceHandler forall (m :: * -> *) r i o. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> UnaryHandler m i o -> ServiceHandler -unary @m @_ @() @() (ServerErrorIO x -> IO x +unary @m @_ @() @() (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) -> (m x -> ServerErrorIO x) -> m x -> IO x forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc (\Request -req () +f) RPCTy p +rpc (\Request +req () _ -> Request -> m () -h Request -req) +h Request +req) ----- -instance (MonadIO m, GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r) - => GRpcMethodHandler p m '[ ] ('RetSingle rref) (m r) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r) + => GRpcMethodHandler p m '[ ] ('RetSingle rref) (m r) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[] -> Proxy ('RetSingle rref) -> RPCTy p -> (Request -> m r) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[] _ Proxy ('RetSingle rref) -_ RPCTy p -rpc Request -> m r -h +_ RPCTy p +rpc Request -> m r +h = (forall x. m x -> IO x) -> RPCTy p -> UnaryHandler m () (GRpcOWTy p rref r) @@ -1037,7 +1037,7 @@ forall (m :: * -> *) r i o. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> UnaryHandler m i o -> ServiceHandler -unary @m @_ @() @(GRpcOWTy p rref r) +unary @m @_ @() @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1045,43 +1045,43 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc - (\Request -req () +f) RPCTy p +rpc + (\Request +req () _ -> Proxy p -> Proxy rref -> r -> GRpcOWTy p rref r forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcOutputWrapper p ref r => Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r buildGRpcOWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy rref +Proxy @p) (Proxy rref forall k (t :: k). Proxy t -Proxy @rref) (r -> GRpcOWTy p rref r) -> m r -> m (GRpcOWTy p rref r) +Proxy @rref) (r -> GRpcOWTy p rref r) -> m r -> m (GRpcOWTy p rref r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Request -> m r -h Request -req) +h Request +req) ----- -instance (MonadIO m, GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r, MonadIO m) - => GRpcMethodHandler p m '[ ] ('RetStream rref) - (ConduitT r Void m () -> m ()) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r, MonadIO m) + => GRpcMethodHandler p m '[ ] ('RetStream rref) + (ConduitT r Void m () -> m ()) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[] -> Proxy ('RetStream rref) -> RPCTy p -> (Request -> ConduitT r Void m () -> m ()) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[] _ Proxy ('RetStream rref) -_ RPCTy p -rpc Request -> ConduitT r Void m () -> m () -h +_ RPCTy p +rpc Request -> ConduitT r Void m () -> m () +h = (forall x. m x -> IO x) -> RPCTy p -> ServerStreamHandler m () (GRpcOWTy p rref r) () @@ -1090,32 +1090,32 @@ forall (m :: * -> *) r i o a. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> ServerStreamHandler m i o a -> ServiceHandler -serverStream @m @_ @() @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x +serverStream @m @_ @() @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) -> (m x -> ServerErrorIO x) -> m x -> IO x forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc ServerStreamHandler m () (GRpcOWTy p rref r) () -sstream - where sstream :: Request -> () - -> m ((), ServerStream m (GRpcOWTy p rref r) ()) - sstream :: ServerStreamHandler m () (GRpcOWTy p rref r) () -sstream Request -req () +f) RPCTy p +rpc ServerStreamHandler m () (GRpcOWTy p rref r) () +sstream + where sstream :: Request -> () + -> m ((), ServerStream m (GRpcOWTy p rref r) ()) + sstream :: ServerStreamHandler m () (GRpcOWTy p rref r) () +sstream Request +req () _ = do -- Variable to connect input and output - TMVar (Maybe r) -var <- IO (TMVar (Maybe r)) -> m (TMVar (Maybe r)) + TMVar (Maybe r) +var <- IO (TMVar (Maybe r)) -> m (TMVar (Maybe r)) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMVar (Maybe r)) forall a. IO (TMVar a) -newEmptyTMVarIO :: m (TMVar (Maybe r)) +newEmptyTMVarIO :: m (TMVar (Maybe r)) -- Start executing the handler - Async () -promise <- IO (Async ()) -> m (Async ()) + Async () +promise <- IO (Async ()) -> m (Async ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ()) forall a b. (a -> b) -> a -> b @@ -1127,20 +1127,20 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall a b. (a -> b) -> a -> b $ m () -> ServerErrorIO () forall a. m a -> ServerErrorIO a -f (Request -> ConduitT r Void m () -> m () -h Request -req (TMVar (Maybe r) -> ConduitT r Void m () +f (Request -> ConduitT r Void m () -> m () +h Request +req (TMVar (Maybe r) -> ConduitT r Void m () forall (m :: * -> *) r. MonadIO m => TMVar (Maybe r) -> ConduitT r Void m () toTMVarConduit TMVar (Maybe r) -var))) +var))) -- Return the information - let readNext :: () -> m (Maybe ((), GRpcOWTy p rref r)) -readNext () + let readNext :: () -> m (Maybe ((), GRpcOWTy p rref r)) +readNext () _ - = do Maybe r -nextOutput <- IO (Maybe r) -> m (Maybe r) + = do Maybe r +nextOutput <- IO (Maybe r) -> m (Maybe r) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe r) -> m (Maybe r)) -> IO (Maybe r) -> m (Maybe r) forall a b. (a -> b) -> a -> b @@ -1151,11 +1151,11 @@ forall a b. (a -> b) -> a -> b $ TMVar (Maybe r) -> STM (Maybe r) forall a. TMVar a -> STM a takeTMVar TMVar (Maybe r) -var +var case Maybe r -nextOutput of - Just r -o -> Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) +nextOutput of + Just r +o -> Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r))) @@ -1170,10 +1170,10 @@ GRpcOutputWrapper p ref r => Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r buildGRpcOWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy rref +Proxy @p) (Proxy rref forall k (t :: k). Proxy t -Proxy @rref) r -o) +Proxy @rref) r +o) Maybe r Nothing -> do IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1182,7 +1182,7 @@ forall a b. (a -> b) -> a -> b $ Async () -> IO () forall a. Async a -> IO () cancel Async () -promise +promise Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe ((), GRpcOWTy p rref r) @@ -1196,26 +1196,26 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall (m :: * -> *) o a. (a -> m (Maybe (a, o))) -> ServerStream m o a ServerStream () -> m (Maybe ((), GRpcOWTy p rref r)) -readNext) +readNext) ----- -instance (MonadIO m, GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) ()) - => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] 'RetNothing (v -> m ()) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) ()) + => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] 'RetNothing (v -> m ()) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[ 'ArgSingle aname vref] -> Proxy 'RetNothing -> RPCTy p -> (Request -> v -> m ()) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[ 'ArgSingle aname vref] _ Proxy 'RetNothing -_ RPCTy p -rpc Request -> v -> m () -h +_ RPCTy p +rpc Request -> v -> m () +h = (forall x. m x -> IO x) -> RPCTy p -> UnaryHandler m (GRpcIWTy p vref v) () @@ -1224,7 +1224,7 @@ forall (m :: * -> *) r i o. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> UnaryHandler m i o -> ServiceHandler -unary @m @_ @(GRpcIWTy p vref v) @() +unary @m @_ @(GRpcIWTy p vref v) @() (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1232,12 +1232,12 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc - (\Request -req -> Request -> v -> m () -h Request -req (v -> m ()) +f) RPCTy p +rpc + (\Request +req -> Request -> v -> m () +h Request +req (v -> m ()) -> (GRpcIWTy p vref v -> v) -> GRpcIWTy p vref v -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v @@ -1246,28 +1246,28 @@ GRpcInputWrapper p ref r => Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r unGRpcIWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy vref +Proxy @p) (Proxy vref forall k (t :: k). Proxy t -Proxy @vref)) +Proxy @vref)) ----- -instance (MonadIO m, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r) - => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] ('RetSingle rref) (v -> m r) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r) + => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] ('RetSingle rref) (v -> m r) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[ 'ArgSingle aname vref] -> Proxy ('RetSingle rref) -> RPCTy p -> (Request -> v -> m r) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[ 'ArgSingle aname vref] _ Proxy ('RetSingle rref) -_ RPCTy p -rpc Request -> v -> m r -h +_ RPCTy p +rpc Request -> v -> m r +h = (forall x. m x -> IO x) -> RPCTy p -> UnaryHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) @@ -1276,7 +1276,7 @@ forall (m :: * -> *) r i o. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> UnaryHandler m i o -> ServiceHandler -unary @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) +unary @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1284,18 +1284,18 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc - (\Request -req -> (Proxy p -> Proxy rref -> r -> GRpcOWTy p rref r +f) RPCTy p +rpc + (\Request +req -> (Proxy p -> Proxy rref -> r -> GRpcOWTy p rref r forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcOutputWrapper p ref r => Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r buildGRpcOWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy rref +Proxy @p) (Proxy rref forall k (t :: k). Proxy t -Proxy @rref) (r -> GRpcOWTy p rref r) -> m r -> m (GRpcOWTy p rref r) +Proxy @rref) (r -> GRpcOWTy p rref r) -> m r -> m (GRpcOWTy p rref r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) (m r -> m (GRpcOWTy p rref r)) @@ -1304,8 +1304,8 @@ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b -> m (GRpcOWTy p rref r) forall b c a. (b -> c) -> (a -> b) -> a -> c . Request -> v -> m r -h Request -req +h Request +req (v -> m r) -> (GRpcIWTy p vref v -> v) -> GRpcIWTy p vref v -> m r forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v @@ -1314,29 +1314,29 @@ GRpcInputWrapper p ref r => Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r unGRpcIWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy vref +Proxy @p) (Proxy vref forall k (t :: k). Proxy t -Proxy @vref)) +Proxy @vref)) ----- -instance (GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m) - => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] ('RetStream rref) - (v -> ConduitT r Void m () -> m ()) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m) + => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] ('RetStream rref) + (v -> ConduitT r Void m () -> m ()) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[ 'ArgSingle aname vref] -> Proxy ('RetStream rref) -> RPCTy p -> (Request -> v -> ConduitT r Void m () -> m ()) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[ 'ArgSingle aname vref] _ Proxy ('RetStream rref) -_ RPCTy p -rpc Request -> v -> ConduitT r Void m () -> m () -h +_ RPCTy p +rpc Request -> v -> ConduitT r Void m () -> m () +h = (forall x. m x -> IO x) -> RPCTy p -> ServerStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () @@ -1345,7 +1345,7 @@ forall (m :: * -> *) r i o a. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> ServerStreamHandler m i o a -> ServiceHandler -serverStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) +serverStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1353,36 +1353,36 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc ServerStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () -sstream - where sstream :: Request -> GRpcIWTy p vref v - -> m ((), ServerStream m (GRpcOWTy p rref r) ()) - sstream :: ServerStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () -sstream Request -req GRpcIWTy p vref v -v = do +f) RPCTy p +rpc ServerStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () +sstream + where sstream :: Request -> GRpcIWTy p vref v + -> m ((), ServerStream m (GRpcOWTy p rref r) ()) + sstream :: ServerStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () +sstream Request +req GRpcIWTy p vref v +v = do -- Variable to connect input and output - TMVar (Maybe r) -var <- IO (TMVar (Maybe r)) -> m (TMVar (Maybe r)) + TMVar (Maybe r) +var <- IO (TMVar (Maybe r)) -> m (TMVar (Maybe r)) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMVar (Maybe r)) forall a. IO (TMVar a) -newEmptyTMVarIO :: m (TMVar (Maybe r)) +newEmptyTMVarIO :: m (TMVar (Maybe r)) -- Start executing the handler - let v' :: v -v' = Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v + let v' :: v +v' = Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper p ref r => Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r unGRpcIWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy vref +Proxy @p) (Proxy vref forall k (t :: k). Proxy t -Proxy @vref) GRpcIWTy p vref v -v - Async () -promise <- IO (Async ()) -> m (Async ()) +Proxy @vref) GRpcIWTy p vref v +v + Async () +promise <- IO (Async ()) -> m (Async ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ()) forall a b. (a -> b) -> a -> b @@ -1394,21 +1394,21 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall a b. (a -> b) -> a -> b $ m () -> ServerErrorIO () forall a. m a -> ServerErrorIO a -f (Request -> v -> ConduitT r Void m () -> m () -h Request -req v -v' (TMVar (Maybe r) -> ConduitT r Void m () +f (Request -> v -> ConduitT r Void m () -> m () +h Request +req v +v' (TMVar (Maybe r) -> ConduitT r Void m () forall (m :: * -> *) r. MonadIO m => TMVar (Maybe r) -> ConduitT r Void m () toTMVarConduit TMVar (Maybe r) -var))) +var))) -- Return the information - let readNext :: () -> m (Maybe ((), GRpcOWTy p rref r)) -readNext () + let readNext :: () -> m (Maybe ((), GRpcOWTy p rref r)) +readNext () _ - = do Maybe r -nextOutput <- IO (Maybe r) -> m (Maybe r) + = do Maybe r +nextOutput <- IO (Maybe r) -> m (Maybe r) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe r) -> m (Maybe r)) -> IO (Maybe r) -> m (Maybe r) forall a b. (a -> b) -> a -> b @@ -1419,11 +1419,11 @@ forall a b. (a -> b) -> a -> b $ TMVar (Maybe r) -> STM (Maybe r) forall a. TMVar a -> STM a takeTMVar TMVar (Maybe r) -var +var case Maybe r -nextOutput of - Just r -o -> Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) +nextOutput of + Just r +o -> Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r))) @@ -1438,10 +1438,10 @@ GRpcOutputWrapper p ref r => Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r buildGRpcOWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy rref +Proxy @p) (Proxy rref forall k (t :: k). Proxy t -Proxy @rref) r -o) +Proxy @rref) r +o) Maybe r Nothing -> do IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1450,7 +1450,7 @@ forall a b. (a -> b) -> a -> b $ Async () -> IO () forall a. Async a -> IO () cancel Async () -promise +promise Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe ((), GRpcOWTy p rref r) @@ -1464,27 +1464,27 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall (m :: * -> *) o a. (a -> m (Maybe (a, o))) -> ServerStream m o a ServerStream () -> m (Maybe ((), GRpcOWTy p rref r)) -readNext) +readNext) ----- -instance (MonadIO m, GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) (), MonadIO m) - => GRpcMethodHandler p m '[ 'ArgStream aname vref ] 'RetNothing - (ConduitT () v m () -> m ()) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) (), MonadIO m) + => GRpcMethodHandler p m '[ 'ArgStream aname vref ] 'RetNothing + (ConduitT () v m () -> m ()) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[ 'ArgStream aname vref] -> Proxy 'RetNothing -> RPCTy p -> (Request -> ConduitT () v m () -> m ()) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[ 'ArgStream aname vref] _ Proxy 'RetNothing -_ RPCTy p -rpc Request -> ConduitT () v m () -> m () -h +_ RPCTy p +rpc Request -> ConduitT () v m () -> m () +h = (forall x. m x -> IO x) -> RPCTy p -> ClientStreamHandler m (GRpcIWTy p vref v) () () @@ -1493,7 +1493,7 @@ forall (m :: * -> *) r i o a. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> ClientStreamHandler m i o a -> ServiceHandler -clientStream @m @_ @(GRpcIWTy p vref v) @() +clientStream @m @_ @(GRpcIWTy p vref v) @() (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1501,29 +1501,29 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc ClientStreamHandler m (GRpcIWTy p vref v) () () -cstream - where cstream :: Request - -> m ((), ClientStream m (GRpcIWTy p vref v) () ()) - cstream :: ClientStreamHandler m (GRpcIWTy p vref v) () () -cstream Request -req = do +f) RPCTy p +rpc ClientStreamHandler m (GRpcIWTy p vref v) () () +cstream + where cstream :: Request + -> m ((), ClientStream m (GRpcIWTy p vref v) () ()) + cstream :: ClientStreamHandler m (GRpcIWTy p vref v) () () +cstream Request +req = do -- Create a new TMChan - TMChan v -chan <- IO (TMChan v) -> m (TMChan v) + TMChan v +chan <- IO (TMChan v) -> m (TMChan v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMChan v) forall a. IO (TMChan a) -newTMChanIO :: m (TMChan v) - let producer :: ConduitT () v m () -producer = TMChan v -> ConduitT () v m () +newTMChanIO :: m (TMChan v) + let producer :: ConduitT () v m () +producer = TMChan v -> ConduitT () v m () forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m () -sourceTMChan @m TMChan v -chan +sourceTMChan @m TMChan v +chan -- Start executing the handler in another thread - Async () -promise <- IO (Async ()) -> m (Async ()) + Async () +promise <- IO (Async ()) -> m (Async ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ()) forall a b. (a -> b) -> a -> b @@ -1535,15 +1535,15 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall a b. (a -> b) -> a -> b $ m () -> ServerErrorIO () forall a. m a -> ServerErrorIO a -f (Request -> ConduitT () v m () -> m () -h Request -req ConduitT () v m () -producer)) +f (Request -> ConduitT () v m () -> m () +h Request +req ConduitT () v m () +producer)) -- Build the actual handler - let cstreamHandler :: () -> GRpcIWTy p vref v -> m () -cstreamHandler () -_ GRpcIWTy p vref v -newInput + let cstreamHandler :: () -> GRpcIWTy p vref v -> m () +cstreamHandler () +_ GRpcIWTy p vref v +newInput = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () @@ -1556,18 +1556,18 @@ forall a b. (a -> b) -> a -> b TMChan v -> v -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan v -chan (Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v +chan (Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper p ref r => Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r unGRpcIWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy vref +Proxy @p) (Proxy vref forall k (t :: k). Proxy t -Proxy @vref) GRpcIWTy p vref v -newInput) - cstreamFinalizer :: () -> m () -cstreamFinalizer () +Proxy @vref) GRpcIWTy p vref v +newInput) + cstreamFinalizer :: () -> m () +cstreamFinalizer () _ = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1578,12 +1578,12 @@ forall a. STM a -> IO a atomically (TMChan v -> STM () forall a. TMChan a -> STM () closeTMChan TMChan v -chan) IO () -> IO () -> IO () +chan) IO () -> IO () -> IO () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Async () -> IO () forall a. Async a -> IO a wait Async () -promise +promise -- Return the information ((), ClientStream m (GRpcIWTy p vref v) () ()) -> m ((), ClientStream m (GRpcIWTy p vref v) () ()) @@ -1593,28 +1593,28 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall (m :: * -> *) i o a. (a -> i -> m a) -> (a -> m o) -> ClientStream m i o a ClientStream () -> GRpcIWTy p vref v -> m () -cstreamHandler () -> m () -cstreamFinalizer) +cstreamHandler () -> m () +cstreamFinalizer) ----- -instance (MonadIO m, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m) - => GRpcMethodHandler p m '[ 'ArgStream aname vref ] ('RetSingle rref) - (ConduitT () v m () -> m r) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (MonadIO m, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m) + => GRpcMethodHandler p m '[ 'ArgStream aname vref ] ('RetSingle rref) + (ConduitT () v m () -> m r) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[ 'ArgStream aname vref] -> Proxy ('RetSingle rref) -> RPCTy p -> (Request -> ConduitT () v m () -> m r) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[ 'ArgStream aname vref] _ Proxy ('RetSingle rref) -_ RPCTy p -rpc Request -> ConduitT () v m () -> m r -h +_ RPCTy p +rpc Request -> ConduitT () v m () -> m r +h = (forall x. m x -> IO x) -> RPCTy p -> ClientStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () @@ -1623,7 +1623,7 @@ forall (m :: * -> *) r i o a. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> ClientStreamHandler m i o a -> ServiceHandler -clientStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) +clientStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1631,30 +1631,30 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc ClientStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () -cstream - where cstream :: Request - -> m ((), ClientStream m (GRpcIWTy p vref v) - (GRpcOWTy p rref r) ()) - cstream :: ClientStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () -cstream Request -req = do +f) RPCTy p +rpc ClientStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () +cstream + where cstream :: Request + -> m ((), ClientStream m (GRpcIWTy p vref v) + (GRpcOWTy p rref r) ()) + cstream :: ClientStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () +cstream Request +req = do -- Create a new TMChan - TMChan v -chan <- IO (TMChan v) -> m (TMChan v) + TMChan v +chan <- IO (TMChan v) -> m (TMChan v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMChan v) forall a. IO (TMChan a) -newTMChanIO :: m (TMChan v) - let producer :: ConduitT () v m () -producer = TMChan v -> ConduitT () v m () +newTMChanIO :: m (TMChan v) + let producer :: ConduitT () v m () +producer = TMChan v -> ConduitT () v m () forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m () -sourceTMChan @m TMChan v -chan +sourceTMChan @m TMChan v +chan -- Start executing the handler in another thread - Async (GRpcOWTy p rref r) -promise <- IO (Async (GRpcOWTy p rref r)) -> m (Async (GRpcOWTy p rref r)) + Async (GRpcOWTy p rref r) +promise <- IO (Async (GRpcOWTy p rref r)) -> m (Async (GRpcOWTy p rref r)) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Async (GRpcOWTy p rref r)) -> m (Async (GRpcOWTy p rref r))) -> IO (Async (GRpcOWTy p rref r)) -> m (Async (GRpcOWTy p rref r)) @@ -1674,23 +1674,23 @@ GRpcOutputWrapper p ref r => Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r buildGRpcOWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy rref +Proxy @p) (Proxy rref forall k (t :: k). Proxy t -Proxy @rref) +Proxy @rref) (r -> GRpcOWTy p rref r) -> ExceptT ServerError IO r -> ServerErrorIO (GRpcOWTy p rref r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m r -> ExceptT ServerError IO r forall a. m a -> ServerErrorIO a -f (Request -> ConduitT () v m () -> m r -h Request -req ConduitT () v m () -producer)) +f (Request -> ConduitT () v m () -> m r +h Request +req ConduitT () v m () +producer)) -- Build the actual handler - let cstreamHandler :: () -> GRpcIWTy p vref v -> m () -cstreamHandler () -_ GRpcIWTy p vref v -newInput + let cstreamHandler :: () -> GRpcIWTy p vref v -> m () +cstreamHandler () +_ GRpcIWTy p vref v +newInput = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () @@ -1703,18 +1703,18 @@ forall a b. (a -> b) -> a -> b TMChan v -> v -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan v -chan (Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v +chan (Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper p ref r => Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r unGRpcIWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy vref +Proxy @p) (Proxy vref forall k (t :: k). Proxy t -Proxy @vref) GRpcIWTy p vref v -newInput) - cstreamFinalizer :: () -> m (GRpcOWTy p rref r) -cstreamFinalizer () +Proxy @vref) GRpcIWTy p vref v +newInput) + cstreamFinalizer :: () -> m (GRpcOWTy p rref r) +cstreamFinalizer () _ = IO (GRpcOWTy p rref r) -> m (GRpcOWTy p rref r) forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1726,12 +1726,12 @@ forall a. STM a -> IO a atomically (TMChan v -> STM () forall a. TMChan a -> STM () closeTMChan TMChan v -chan) IO () -> IO (GRpcOWTy p rref r) -> IO (GRpcOWTy p rref r) +chan) IO () -> IO (GRpcOWTy p rref r) -> IO (GRpcOWTy p rref r) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Async (GRpcOWTy p rref r) -> IO (GRpcOWTy p rref r) forall a. Async a -> IO a wait Async (GRpcOWTy p rref r) -promise +promise -- Return the information ((), ClientStream m (GRpcIWTy p vref v) (GRpcOWTy p rref r) ()) -> m ((), @@ -1743,28 +1743,28 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall (m :: * -> *) i o a. (a -> i -> m a) -> (a -> m o) -> ClientStream m i o a ClientStream () -> GRpcIWTy p vref v -> m () -cstreamHandler () -> m (GRpcOWTy p rref r) -cstreamFinalizer) +cstreamHandler () -> m (GRpcOWTy p rref r) +cstreamFinalizer) ----- -instance (GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m) - => GRpcMethodHandler p m '[ 'ArgStream aname vref ] ('RetStream rref) - (ConduitT () v m () -> ConduitT r Void m () -> m ()) where - gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) +instance (GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m) + => GRpcMethodHandler p m '[ 'ArgStream aname vref ] ('RetStream rref) + (ConduitT () v m () -> ConduitT r Void m () -> m ()) where + gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a) -> Proxy p -> Proxy '[ 'ArgStream aname vref] -> Proxy ('RetStream rref) -> RPCTy p -> (Request -> ConduitT () v m () -> ConduitT r Void m () -> m ()) -> ServiceHandler -gRpcMethodHandler forall a. m a -> ServerErrorIO a -f Proxy p +gRpcMethodHandler forall a. m a -> ServerErrorIO a +f Proxy p _ Proxy '[ 'ArgStream aname vref] _ Proxy ('RetStream rref) -_ RPCTy p -rpc Request -> ConduitT () v m () -> ConduitT r Void m () -> m () -h +_ RPCTy p +rpc Request -> ConduitT () v m () -> ConduitT r Void m () -> m () +h = (forall x. m x -> IO x) -> RPCTy p -> GeneralStreamHandler @@ -1774,7 +1774,7 @@ forall (m :: * -> *) r i o a b. (MonadIO m, GRPCInput r i, GRPCOutput r o) => (forall x. m x -> IO x) -> r -> GeneralStreamHandler m i o a b -> ServiceHandler -generalStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) +generalStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) (ServerErrorIO x -> IO x forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a raiseErrors (ServerErrorIO x -> IO x) @@ -1782,50 +1782,50 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m x -> ServerErrorIO x forall a. m a -> ServerErrorIO a -f) RPCTy p -rpc GeneralStreamHandler +f) RPCTy p +rpc GeneralStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () () -bdstream - where bdstream :: Request - -> m ( (), IncomingStream m (GRpcIWTy p vref v) () - , (), OutgoingStream m (GRpcOWTy p rref r) () ) - bdstream :: GeneralStreamHandler +bdstream + where bdstream :: Request + -> m ( (), IncomingStream m (GRpcIWTy p vref v) () + , (), OutgoingStream m (GRpcOWTy p rref r) () ) + bdstream :: GeneralStreamHandler m (GRpcIWTy p vref v) (GRpcOWTy p rref r) () () -bdstream Request -req = do +bdstream Request +req = do -- Create a new TMChan for consuming the client stream, it will be -- the producer for the conduit. - TMChan v -clientChan <- IO (TMChan v) -> m (TMChan v) + TMChan v +clientChan <- IO (TMChan v) -> m (TMChan v) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMChan v) forall a. IO (TMChan a) -newTMChanIO :: m (TMChan v) - let producer :: ConduitT () v m () -producer = TMChan v -> ConduitT () v m () +newTMChanIO :: m (TMChan v) + let producer :: ConduitT () v m () +producer = TMChan v -> ConduitT () v m () forall (m :: * -> *) a. MonadIO m => TMChan a -> ConduitT () a m () -sourceTMChan @m TMChan v -clientChan +sourceTMChan @m TMChan v +clientChan -- Create a new TMChan for producing the server stream, it will be -- the consumer for the conduit. - TMChan r -serverChan <- IO (TMChan r) -> m (TMChan r) + TMChan r +serverChan <- IO (TMChan r) -> m (TMChan r) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO (TMChan r) forall a. IO (TMChan a) -newTMChanIO :: m (TMChan r) - let consumer :: ConduitT r Void m () -consumer = TMChan r -> ConduitT r Void m () +newTMChanIO :: m (TMChan r) + let consumer :: ConduitT r Void m () +consumer = TMChan r -> ConduitT r Void m () forall (m :: * -> *) a z. MonadIO m => TMChan a -> ConduitT a z m () -sinkTMChan @m TMChan r -serverChan +sinkTMChan @m TMChan r +serverChan -- Start executing the handler - Async () -handlerPromise <- IO (Async ()) -> m (Async ()) + Async () +handlerPromise <- IO (Async ()) -> m (Async ()) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Async ()) -> m (Async ())) -> IO (Async ()) -> m (Async ()) forall a b. (a -> b) -> a -> b @@ -1840,13 +1840,13 @@ forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a forall a b. (a -> b) -> a -> b $ m () -> ServerErrorIO () forall a. m a -> ServerErrorIO a -f (m () -> ServerErrorIO ()) -> m () -> ServerErrorIO () +f (m () -> ServerErrorIO ()) -> m () -> ServerErrorIO () forall a b. (a -> b) -> a -> b $ Request -> ConduitT () v m () -> ConduitT r Void m () -> m () -h Request -req ConduitT () v m () -producer ConduitT r Void m () -consumer +h Request +req ConduitT () v m () +producer ConduitT r Void m () +consumer STM () -> IO () forall a. STM a -> IO a atomically (STM () -> IO ()) -> STM () -> IO () @@ -1854,13 +1854,13 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> STM () forall a. TMChan a -> STM () closeTMChan TMChan r -serverChan +serverChan -- Build the actual handler - let cstreamHandler :: () -> GRpcIWTy p vref v -> m () -cstreamHandler () -_ GRpcIWTy p vref v -newInput + let cstreamHandler :: () -> GRpcIWTy p vref v -> m () +cstreamHandler () +_ GRpcIWTy p vref v +newInput = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () @@ -1873,18 +1873,18 @@ forall a b. (a -> b) -> a -> b TMChan v -> v -> STM () forall a. TMChan a -> a -> STM () writeTMChan TMChan v -clientChan (Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v +clientChan (Proxy p -> Proxy vref -> GRpcIWTy p vref v -> v forall snm (p :: GRpcMessageProtocol) (ref :: TypeRef snm) r. GRpcInputWrapper p ref r => Proxy p -> Proxy ref -> GRpcIWTy p ref r -> r unGRpcIWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy vref +Proxy @p) (Proxy vref forall k (t :: k). Proxy t -Proxy @vref) GRpcIWTy p vref v -newInput) - cstreamFinalizer :: () -> m () -cstreamFinalizer () +Proxy @vref) GRpcIWTy p vref v +newInput) + cstreamFinalizer :: () -> m () +cstreamFinalizer () _ = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a @@ -1895,17 +1895,17 @@ forall a. STM a -> IO a atomically (TMChan v -> STM () forall a. TMChan a -> STM () closeTMChan TMChan v -clientChan) IO () -> IO () -> IO () +clientChan) IO () -> IO () -> IO () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Async () -> IO () forall a. Async a -> IO a wait Async () -handlerPromise - readNext :: () -> m (Maybe ((), GRpcOWTy p rref r)) -readNext () +handlerPromise + readNext :: () -> m (Maybe ((), GRpcOWTy p rref r)) +readNext () _ - = do Maybe r -nextOutput <- IO (Maybe r) -> m (Maybe r) + = do Maybe r +nextOutput <- IO (Maybe r) -> m (Maybe r) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe r) -> m (Maybe r)) -> IO (Maybe r) -> m (Maybe r) forall a b. (a -> b) -> a -> b @@ -1916,11 +1916,11 @@ forall a b. (a -> b) -> a -> b $ TMChan r -> STM (Maybe r) forall a. TMChan a -> STM (Maybe a) readTMChan TMChan r -serverChan +serverChan case Maybe r -nextOutput of - Just r -o -> +nextOutput of + Just r +o -> Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe ((), GRpcOWTy p rref r) @@ -1936,10 +1936,10 @@ GRpcOutputWrapper p ref r => Proxy p -> Proxy ref -> r -> GRpcOWTy p ref r buildGRpcOWTy (Proxy p forall k (t :: k). Proxy t -Proxy @p) (Proxy rref +Proxy @p) (Proxy rref forall k (t :: k). Proxy t -Proxy @rref) r -o) +Proxy @rref) r +o) Maybe r Nothing -> do Maybe ((), GRpcOWTy p rref r) -> m (Maybe ((), GRpcOWTy p rref r)) @@ -1957,22 +1957,22 @@ forall (f :: * -> *) a. Applicative f => a -> f a forall (m :: * -> *) i a. (a -> i -> m a) -> (a -> m ()) -> IncomingStream m i a IncomingStream () -> GRpcIWTy p vref v -> m () -cstreamHandler () -> m () -cstreamFinalizer, (), (() -> m (Maybe ((), GRpcOWTy p rref r))) +cstreamHandler () -> m () +cstreamFinalizer, (), (() -> m (Maybe ((), GRpcOWTy p rref r))) -> OutgoingStream m (GRpcOWTy p rref r) () forall (m :: * -> *) o a. (a -> m (Maybe (a, o))) -> OutgoingStream m o a OutgoingStream () -> m (Maybe ((), GRpcOWTy p rref r)) -readNext) +readNext) ----- -toTMVarConduit :: MonadIO m => TMVar (Maybe r) -> ConduitT r Void m () +toTMVarConduit :: MonadIO m => TMVar (Maybe r) -> ConduitT r Void m () toTMVarConduit :: TMVar (Maybe r) -> ConduitT r Void m () -toTMVarConduit TMVar (Maybe r) -var = do - Maybe r -x <- ConduitT r Void m (Maybe r) +toTMVarConduit TMVar (Maybe r) +var = do + Maybe r +x <- ConduitT r Void m (Maybe r) forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i) await IO () -> ConduitT r Void m () @@ -1986,12 +1986,12 @@ forall a b. (a -> b) -> a -> b $ TMVar (Maybe r) -> Maybe r -> STM () forall a. TMVar a -> a -> STM () putTMVar TMVar (Maybe r) -var Maybe r -x +var Maybe r +x TMVar (Maybe r) -> ConduitT r Void m () forall (m :: * -> *) r. MonadIO m => TMVar (Maybe r) -> ConduitT r Void m () toTMVarConduit TMVar (Maybe r) -var +var \ No newline at end of file diff --git a/wip/haddock/mu-kafka/Mu-Kafka-Producer.html b/wip/haddock/mu-kafka/Mu-Kafka-Producer.html index cfd479e..0e2ae42 100644 --- a/wip/haddock/mu-kafka/Mu-Kafka-Producer.html +++ b/wip/haddock/mu-kafka/Mu-Kafka-Producer.html @@ -1,7 +1,7 @@ Mu.Kafka.Producer
mu-kafka-0.3.0.0: Utilities for interoperation between Mu and Kafka
Safe HaskellNone
LanguageHaskell2010

Mu.Kafka.Producer

Description

This module allows you to open a "sink" to Kafka. Every value you sent to the sink will be sent over to the corresponding Kafka instance.

This module is a wrapper over Sink -from the (awesome) package hw-kafka-client.

Synopsis

Documentation

data ProducerRecord' k v Source #

Constructors

ProducerRecord' 

Fields

Instances

Instances details
(Eq k, Eq v) => Eq (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

Methods

(==) :: ProducerRecord' k v -> ProducerRecord' k v -> Bool #

(/=) :: ProducerRecord' k v -> ProducerRecord' k v -> Bool #

(Show k, Show v) => Show (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

Methods

showsPrec :: Int -> ProducerRecord' k v -> ShowS #

show :: ProducerRecord' k v -> String #

showList :: [ProducerRecord' k v] -> ShowS #

Generic (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

Associated Types

type Rep (ProducerRecord' k v) :: Type -> Type #

Methods

from :: ProducerRecord' k v -> Rep (ProducerRecord' k v) x #

to :: Rep (ProducerRecord' k v) x -> ProducerRecord' k v #

type Rep (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

type Rep (ProducerRecord' k v) = D1 ('MetaData "ProducerRecord'" "Mu.Kafka.Producer" "mu-kafka-0.3.0.0-5Sg9SjEbRHZLgRNkFWP0rG" 'False) (C1 ('MetaCons "ProducerRecord'" 'PrefixI 'True) ((S1 ('MetaSel ('Just "prTopic") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TopicName) :*: S1 ('MetaSel ('Just "prPartition") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ProducePartition)) :*: (S1 ('MetaSel ('Just "prKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe k)) :*: S1 ('MetaSel ('Just "prValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe v)))))

kafkaSink :: (MonadResource m, ToSchema sch sty t, ToAvro (WithSchema sch sty t), HasAvroSchema (WithSchema sch sty t)) => Proxy sch -> ProducerProperties -> ConduitT (ProducerRecord' ByteString t) Void m (Maybe KafkaError) Source #

Creates a kafka producer for given properties and returns a Sink.

This method of creating a Sink represents a simple case +from the (awesome) package hw-kafka-client.

Synopsis

Documentation

data ProducerRecord' k v Source #

Constructors

ProducerRecord' 

Fields

Instances

Instances details
(Eq k, Eq v) => Eq (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

Methods

(==) :: ProducerRecord' k v -> ProducerRecord' k v -> Bool #

(/=) :: ProducerRecord' k v -> ProducerRecord' k v -> Bool #

(Show k, Show v) => Show (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

Methods

showsPrec :: Int -> ProducerRecord' k v -> ShowS #

show :: ProducerRecord' k v -> String #

showList :: [ProducerRecord' k v] -> ShowS #

Generic (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

Associated Types

type Rep (ProducerRecord' k v) :: Type -> Type #

Methods

from :: ProducerRecord' k v -> Rep (ProducerRecord' k v) x #

to :: Rep (ProducerRecord' k v) x -> ProducerRecord' k v #

type Rep (ProducerRecord' k v) Source # 
Instance details

Defined in Mu.Kafka.Producer

type Rep (ProducerRecord' k v) = D1 ('MetaData "ProducerRecord'" "Mu.Kafka.Producer" "mu-kafka-0.3.0.0-9gnAS3zhTFI3DkZtxEgnF8" 'False) (C1 ('MetaCons "ProducerRecord'" 'PrefixI 'True) ((S1 ('MetaSel ('Just "prTopic") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TopicName) :*: S1 ('MetaSel ('Just "prPartition") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ProducePartition)) :*: (S1 ('MetaSel ('Just "prKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe k)) :*: S1 ('MetaSel ('Just "prValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe v)))))

kafkaSink :: (MonadResource m, ToSchema sch sty t, ToAvro (WithSchema sch sty t), HasAvroSchema (WithSchema sch sty t)) => Proxy sch -> ProducerProperties -> ConduitT (ProducerRecord' ByteString t) Void m (Maybe KafkaError) Source #

Creates a kafka producer for given properties and returns a Sink.

This method of creating a Sink represents a simple case and does not provide access to KafkaProducer. For more complex scenarious kafkaSinkAutoClose or kafkaSinkNoClose can be used.

kafkaSinkAutoClose :: (MonadResource m, ToSchema sch sty t, ToAvro (WithSchema sch sty t), HasAvroSchema (WithSchema sch sty t)) => Proxy sch -> KafkaProducer -> ConduitT (ProducerRecord' ByteString t) Void m (Maybe KafkaError) Source #

Creates a Sink for a given KafkaProducer. The producer will be closed when the Sink is closed.

kafkaSinkNoClose :: (MonadIO m, ToSchema sch sty t, ToAvro (WithSchema sch sty t), HasAvroSchema (WithSchema sch sty t)) => Proxy sch -> KafkaProducer -> ConduitT (ProducerRecord' ByteString t) Void m (Maybe KafkaError) Source #

Creates a Sink for a given KafkaProducer. diff --git a/wip/haddock/mu-kafka/mu-kafka.haddock b/wip/haddock/mu-kafka/mu-kafka.haddock index deb5e06..de0b5e2 100644 Binary files a/wip/haddock/mu-kafka/mu-kafka.haddock and b/wip/haddock/mu-kafka/mu-kafka.haddock differ diff --git a/wip/haddock/mu-lens/mu-lens.haddock b/wip/haddock/mu-lens/mu-lens.haddock index 5ec02cb..23493d1 100644 Binary files a/wip/haddock/mu-lens/mu-lens.haddock and b/wip/haddock/mu-lens/mu-lens.haddock differ diff --git a/wip/haddock/mu-optics/mu-optics.haddock b/wip/haddock/mu-optics/mu-optics.haddock index 8cfa71c..570e391 100644 Binary files a/wip/haddock/mu-optics/mu-optics.haddock and b/wip/haddock/mu-optics/mu-optics.haddock differ diff --git a/wip/haddock/mu-optics/src/Mu.Schema.Optics.html b/wip/haddock/mu-optics/src/Mu.Schema.Optics.html index c365bcc..b84118a 100644 --- a/wip/haddock/mu-optics/src/Mu.Schema.Optics.html +++ b/wip/haddock/mu-optics/src/Mu.Schema.Optics.html @@ -50,12 +50,12 @@ as values in the schema type. import Mu.Schema -instance (FieldLabel sch args fieldName r) - => LabelOptic fieldName A_Lens - (Term sch ('DRecord name args)) - (Term sch ('DRecord name args)) - r r where - labelOptic :: Optic +instance (FieldLabel sch args fieldName r) + => LabelOptic fieldName A_Lens + (Term sch ('DRecord name args)) + (Term sch ('DRecord name args)) + r r where + labelOptic :: Optic A_Lens NoIx (Term sch ('DRecord name args)) @@ -73,20 +73,20 @@ as values in the schema type. r r forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b -lens (\(TRecord NP (Field sch) args -r) -> Proxy fieldName -> NP (Field sch) args -> r +lens (\(TRecord NP (Field sch) args +r) -> Proxy fieldName -> NP (Field sch) args -> r forall (sch :: Schema Symbol Symbol) (args :: [FieldDef Symbol Symbol]) (fieldName :: Symbol) r. FieldLabel sch args fieldName r => Proxy fieldName -> NP (Field sch) args -> r fieldLensGet (Proxy fieldName forall k (t :: k). Proxy t -Proxy @fieldName) NP (Field sch) args +Proxy @fieldName) NP (Field sch) args NP (Field sch) args -r) - (\(TRecord NP (Field sch) args -r) r -x -> NP (Field sch) args -> Term sch ('DRecord name args) +r) + (\(TRecord NP (Field sch) args +r) r +x -> NP (Field sch) args -> Term sch ('DRecord name args) forall typeName fieldName (sch :: Schema typeName fieldName) (args :: [FieldDef typeName fieldName]) (name :: typeName). NP (Field sch) args -> Term sch ('DRecord name args) @@ -100,19 +100,19 @@ FieldLabel sch args fieldName r => Proxy fieldName -> NP (Field sch) args -> r -> NP (Field sch) args fieldLensSet (Proxy fieldName forall k (t :: k). Proxy t -Proxy @fieldName) NP (Field sch) args +Proxy @fieldName) NP (Field sch) args NP (Field sch) args -r r -x) +r r +x) -- | Build a Mu record 'Term' from a tuple of its values. -- -- Note: if the record has exactly _one_ field, -- you must use 'record1' instead. -record :: BuildRecord sch args r => r -> Term sch ('DRecord name args) +record :: BuildRecord sch args r => r -> Term sch ('DRecord name args) record :: r -> Term sch ('DRecord name args) -record r -values = NP (Field sch) args -> Term sch ('DRecord name args) +record r +values = NP (Field sch) args -> Term sch ('DRecord name args) forall typeName fieldName (sch :: Schema typeName fieldName) (args :: [FieldDef typeName fieldName]) (name :: typeName). NP (Field sch) args -> Term sch ('DRecord name args) @@ -125,13 +125,13 @@ forall (sch :: Schema Symbol Symbol) BuildRecord sch args r => r -> NP (Field sch) args buildR r -values +values -- | Build a Mu record 'Term' with exactly one field. -record1 :: TypeLabel sch t1 r1 => r1 -> Term sch ('DRecord name '[ 'FieldDef x1 t1 ]) +record1 :: TypeLabel sch t1 r1 => r1 -> Term sch ('DRecord name '[ 'FieldDef x1 t1 ]) record1 :: r1 -> Term sch ('DRecord name '[ 'FieldDef x1 t1]) -record1 r1 -value = NP (Field sch) '[ 'FieldDef x1 t1] +record1 r1 +value = NP (Field sch) '[ 'FieldDef x1 t1] -> Term sch ('DRecord name '[ 'FieldDef x1 t1]) forall typeName fieldName (sch :: Schema typeName fieldName) (args :: [FieldDef typeName fieldName]) (name :: typeName). @@ -150,7 +150,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r1 -value) Field sch ('FieldDef x1 t1) +value) Field sch ('FieldDef x1 t1) -> NP (Field sch) '[] -> NP (Field sch) '[ 'FieldDef x1 t1] forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NP a xs -> NP a (x : xs) @@ -158,24 +158,24 @@ a x -> NP a xs -> NP a (x : xs) forall k (a :: k -> *). NP a '[] Nil -class BuildRecord (sch :: Schema Symbol Symbol) - (args :: [FieldDef Symbol Symbol]) - (r :: Type) | sch args -> r where - buildR :: r -> NP (Field sch) args +class BuildRecord (sch :: Schema Symbol Symbol) + (args :: [FieldDef Symbol Symbol]) + (r :: Type) | sch args -> r where + buildR :: r -> NP (Field sch) args -instance BuildRecord sch '[] () where - buildR :: () -> NP (Field sch) '[] -buildR () +instance BuildRecord sch '[] () where + buildR :: () -> NP (Field sch) '[] +buildR () _ = NP (Field sch) '[] forall k (a :: k -> *). NP a '[] Nil -instance (TypeLabel sch t1 r1, TypeLabel sch t2 r2) - => BuildRecord sch '[ 'FieldDef x1 t1, 'FieldDef x2 t2 ] (r1, r2) where - buildR :: (r1, r2) -> NP (Field sch) '[ 'FieldDef x1 t1, 'FieldDef x2 t2] -buildR (r1 -v1, r2 -v2) = FieldValue sch t1 -> Field sch ('FieldDef x1 t1) +instance (TypeLabel sch t1 r1, TypeLabel sch t2 r2) + => BuildRecord sch '[ 'FieldDef x1 t1, 'FieldDef x2 t2 ] (r1, r2) where + buildR :: (r1, r2) -> NP (Field sch) '[ 'FieldDef x1 t1, 'FieldDef x2 t2] +buildR (r1 +v1, r2 +v2) = FieldValue sch t1 -> Field sch ('FieldDef x1 t1) forall typeName fieldName (sch :: Schema typeName fieldName) (t :: FieldType typeName) (name :: fieldName). FieldValue sch t -> Field sch ('FieldDef name t) @@ -184,7 +184,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r1 -v1) +v1) Field sch ('FieldDef x1 t1) -> NP (Field sch) '[ 'FieldDef x2 t2] -> NP (Field sch) '[ 'FieldDef x1 t1, 'FieldDef x2 t2] @@ -199,7 +199,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r2 -v2) Field sch ('FieldDef x2 t2) +v2) Field sch ('FieldDef x2 t2) -> NP (Field sch) '[] -> NP (Field sch) '[ 'FieldDef x2 t2] forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NP a xs -> NP a (x : xs) @@ -207,16 +207,16 @@ a x -> NP a xs -> NP a (x : xs) forall k (a :: k -> *). NP a '[] Nil -instance (TypeLabel sch t1 r1, TypeLabel sch t2 r2, TypeLabel sch t3 r3) - => BuildRecord sch - '[ 'FieldDef x1 t1, 'FieldDef x2 t2, 'FieldDef x3 t3 ] (r1, r2, r3) where - buildR :: (r1, r2, r3) +instance (TypeLabel sch t1 r1, TypeLabel sch t2 r2, TypeLabel sch t3 r3) + => BuildRecord sch + '[ 'FieldDef x1 t1, 'FieldDef x2 t2, 'FieldDef x3 t3 ] (r1, r2, r3) where + buildR :: (r1, r2, r3) -> NP (Field sch) '[ 'FieldDef x1 t1, 'FieldDef x2 t2, 'FieldDef x3 t3] -buildR (r1 -v1, r2 -v2, r3 -v3) = FieldValue sch t1 -> Field sch ('FieldDef x1 t1) +buildR (r1 +v1, r2 +v2, r3 +v3) = FieldValue sch t1 -> Field sch ('FieldDef x1 t1) forall typeName fieldName (sch :: Schema typeName fieldName) (t :: FieldType typeName) (name :: fieldName). FieldValue sch t -> Field sch ('FieldDef name t) @@ -225,7 +225,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r1 -v1) +v1) Field sch ('FieldDef x1 t1) -> NP (Field sch) '[ 'FieldDef x2 t2, 'FieldDef x3 t3] -> NP @@ -241,7 +241,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r2 -v2) +v2) Field sch ('FieldDef x2 t2) -> NP (Field sch) '[ 'FieldDef x3 t3] -> NP (Field sch) '[ 'FieldDef x2 t2, 'FieldDef x3 t3] @@ -256,7 +256,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r3 -v3) Field sch ('FieldDef x3 t3) +v3) Field sch ('FieldDef x3 t3) -> NP (Field sch) '[] -> NP (Field sch) '[ 'FieldDef x3 t3] forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NP a xs -> NP a (x : xs) @@ -264,12 +264,12 @@ a x -> NP a xs -> NP a (x : xs) forall k (a :: k -> *). NP a '[] Nil -class FieldLabel (sch :: Schema Symbol Symbol) - (args :: [FieldDef Symbol Symbol]) - (fieldName :: Symbol) (r :: Type) - | sch args fieldName -> r where - fieldLensGet :: Proxy fieldName -> NP (Field sch) args -> r - fieldLensSet :: Proxy fieldName -> NP (Field sch) args -> r -> NP (Field sch) args +class FieldLabel (sch :: Schema Symbol Symbol) + (args :: [FieldDef Symbol Symbol]) + (fieldName :: Symbol) (r :: Type) + | sch args fieldName -> r where + fieldLensGet :: Proxy fieldName -> NP (Field sch) args -> r + fieldLensSet :: Proxy fieldName -> NP (Field sch) args -> r -> NP (Field sch) args {- Removed due to FunDeps instance TypeError ('Text "cannot find field " ':<>: 'ShowType f) @@ -277,27 +277,27 @@ instance TypeError ('Text "cannot find field " ':<>: 'ShowType f fieldLensGet = error "this should never be run" fieldLensSet = error "this should never be run" -} -instance {-# OVERLAPS #-} (TypeLabel sch t r) - => FieldLabel sch ('FieldDef f t ': rest) f r where - fieldLensGet :: Proxy f -> NP (Field sch) ('FieldDef f t : rest) -> r -fieldLensGet Proxy f -_ (Field FieldValue sch t -x :* NP (Field sch) xs +instance {-# OVERLAPS #-} (TypeLabel sch t r) + => FieldLabel sch ('FieldDef f t ': rest) f r where + fieldLensGet :: Proxy f -> NP (Field sch) ('FieldDef f t : rest) -> r +fieldLensGet Proxy f +_ (Field FieldValue sch t +x :* NP (Field sch) xs _) = FieldValue sch t -> r forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => FieldValue sch t -> r typeLensGet FieldValue sch t -x - fieldLensSet :: Proxy f +x + fieldLensSet :: Proxy f -> NP (Field sch) ('FieldDef f t : rest) -> r -> NP (Field sch) ('FieldDef f t : rest) -fieldLensSet Proxy f +fieldLensSet Proxy f _ (Field sch x -_ :* NP (Field sch) xs -r) r -new = FieldValue sch t -> Field sch ('FieldDef f t) +_ :* NP (Field sch) xs +r) r +new = FieldValue sch t -> Field sch ('FieldDef f t) forall typeName fieldName (sch :: Schema typeName fieldName) (t :: FieldType typeName) (name :: fieldName). FieldValue sch t -> Field sch ('FieldDef name t) @@ -306,34 +306,34 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet r -new) Field sch ('FieldDef f t) +new) Field sch ('FieldDef f t) -> NP (Field sch) xs -> NP (Field sch) ('FieldDef f t : xs) forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NP a xs -> NP a (x : xs) :* NP (Field sch) xs -r -instance {-# OVERLAPPABLE #-} FieldLabel sch rest g t - => FieldLabel sch (f ': rest) g t where - fieldLensGet :: Proxy g -> NP (Field sch) (f : rest) -> t -fieldLensGet Proxy g -p (Field sch x -_ :* NP (Field sch) xs -r) = Proxy g -> NP (Field sch) xs -> t +r +instance {-# OVERLAPPABLE #-} FieldLabel sch rest g t + => FieldLabel sch (f ': rest) g t where + fieldLensGet :: Proxy g -> NP (Field sch) (f : rest) -> t +fieldLensGet Proxy g +p (Field sch x +_ :* NP (Field sch) xs +r) = Proxy g -> NP (Field sch) xs -> t forall (sch :: Schema Symbol Symbol) (args :: [FieldDef Symbol Symbol]) (fieldName :: Symbol) r. FieldLabel sch args fieldName r => Proxy fieldName -> NP (Field sch) args -> r fieldLensGet Proxy g -p NP (Field sch) xs -r - fieldLensSet :: Proxy g +p NP (Field sch) xs +r + fieldLensSet :: Proxy g -> NP (Field sch) (f : rest) -> t -> NP (Field sch) (f : rest) -fieldLensSet Proxy g -p (Field sch x -x :* NP (Field sch) xs -r) t -new = Field sch x -x Field sch x -> NP (Field sch) xs -> NP (Field sch) (x : xs) +fieldLensSet Proxy g +p (Field sch x +x :* NP (Field sch) xs +r) t +new = Field sch x +x Field sch x -> NP (Field sch) xs -> NP (Field sch) (x : xs) forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NP a xs -> NP a (x : xs) :* Proxy g -> NP (Field sch) xs -> t -> NP (Field sch) xs @@ -342,55 +342,55 @@ forall (sch :: Schema Symbol Symbol) FieldLabel sch args fieldName r => Proxy fieldName -> NP (Field sch) args -> r -> NP (Field sch) args fieldLensSet Proxy g -p NP (Field sch) xs -r t -new +p NP (Field sch) xs +r t +new -class TypeLabel (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) (r :: Type) - | sch t -> r where - typeLensGet :: FieldValue sch t -> r - typeLensSet :: r -> FieldValue sch t +class TypeLabel (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) (r :: Type) + | sch t -> r where + typeLensGet :: FieldValue sch t -> r + typeLensSet :: r -> FieldValue sch t -instance TypeLabel sch ('TPrimitive t) t where - typeLensGet :: FieldValue sch ('TPrimitive t) -> t -typeLensGet (FPrimitive t1 -x) = t +instance TypeLabel sch ('TPrimitive t) t where + typeLensGet :: FieldValue sch ('TPrimitive t) -> t +typeLensGet (FPrimitive t1 +x) = t t1 -x - typeLensSet :: t -> FieldValue sch ('TPrimitive t) -typeLensSet = t -> FieldValue sch ('TPrimitive t) +x + typeLensSet :: t -> FieldValue sch ('TPrimitive t) +typeLensSet = t -> FieldValue sch ('TPrimitive t) forall typeName fieldName t1 (sch :: Schema typeName fieldName). t1 -> FieldValue sch ('TPrimitive t1) FPrimitive -instance (r ~ (sch :/: t)) => TypeLabel sch ('TSchematic t) (Term sch r) where - typeLensGet :: FieldValue sch ('TSchematic t) -> Term sch r -typeLensGet (FSchematic Term sch (sch :/: t1) -x) = Term sch r +instance (r ~ (sch :/: t)) => TypeLabel sch ('TSchematic t) (Term sch r) where + typeLensGet :: FieldValue sch ('TSchematic t) -> Term sch r +typeLensGet (FSchematic Term sch (sch :/: t1) +x) = Term sch r Term sch (sch :/: t1) -x - typeLensSet :: Term sch r -> FieldValue sch ('TSchematic t) -typeLensSet = Term sch r -> FieldValue sch ('TSchematic t) +x + typeLensSet :: Term sch r -> FieldValue sch ('TSchematic t) +typeLensSet = Term sch r -> FieldValue sch ('TSchematic t) forall typeName fieldName (sch :: Schema typeName fieldName) (t1 :: typeName). Term sch (sch :/: t1) -> FieldValue sch ('TSchematic t1) FSchematic -instance (TypeLabel sch o r', r ~ Maybe r') - => TypeLabel sch ('TOption o) r where - typeLensGet :: FieldValue sch ('TOption o) -> r -typeLensGet (FOption Maybe (FieldValue sch t1) -x) = FieldValue sch t1 -> r' +instance (TypeLabel sch o r', r ~ Maybe r') + => TypeLabel sch ('TOption o) r where + typeLensGet :: FieldValue sch ('TOption o) -> r +typeLensGet (FOption Maybe (FieldValue sch t1) +x) = FieldValue sch t1 -> r' forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => FieldValue sch t -> r typeLensGet (FieldValue sch t1 -> r') -> Maybe (FieldValue sch t1) -> Maybe r' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (FieldValue sch t1) -x - typeLensSet :: r -> FieldValue sch ('TOption o) -typeLensSet r -new = Maybe (FieldValue sch o) -> FieldValue sch ('TOption o) +x + typeLensSet :: r -> FieldValue sch ('TOption o) +typeLensSet r +new = Maybe (FieldValue sch o) -> FieldValue sch ('TOption o) forall typeName fieldName (sch :: Schema typeName fieldName) (t1 :: FieldType typeName). Maybe (FieldValue sch t1) -> FieldValue sch ('TOption t1) @@ -402,23 +402,23 @@ r -> FieldValue sch t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> r Maybe r' -new) +new) -instance (TypeLabel sch o r', r ~ [r']) - => TypeLabel sch ('TList o) r where - typeLensGet :: FieldValue sch ('TList o) -> r -typeLensGet (FList [FieldValue sch t1] -x) = FieldValue sch t1 -> r' +instance (TypeLabel sch o r', r ~ [r']) + => TypeLabel sch ('TList o) r where + typeLensGet :: FieldValue sch ('TList o) -> r +typeLensGet (FList [FieldValue sch t1] +x) = FieldValue sch t1 -> r' forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => FieldValue sch t -> r typeLensGet (FieldValue sch t1 -> r') -> [FieldValue sch t1] -> [r'] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [FieldValue sch t1] -x - typeLensSet :: r -> FieldValue sch ('TList o) -typeLensSet r -new = [FieldValue sch o] -> FieldValue sch ('TList o) +x + typeLensSet :: r -> FieldValue sch ('TList o) +typeLensSet r +new = [FieldValue sch o] -> FieldValue sch ('TList o) forall typeName fieldName (sch :: Schema typeName fieldName) (t1 :: FieldType typeName). [FieldValue sch t1] -> FieldValue sch ('TList t1) @@ -430,14 +430,14 @@ r -> FieldValue sch t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> r [r'] -new) +new) -instance ( TypeLabel sch k k', TypeLabel sch v v' - , r ~ Map k' v', Ord k', Ord (FieldValue sch k) ) - => TypeLabel sch ('TMap k v) r where - typeLensGet :: FieldValue sch ('TMap k v) -> r -typeLensGet (FMap Map (FieldValue sch k) (FieldValue sch v) -x) = (FieldValue sch k -> k') -> Map (FieldValue sch k) v' -> Map k' v' +instance ( TypeLabel sch k k', TypeLabel sch v v' + , r ~ Map k' v', Ord k', Ord (FieldValue sch k) ) + => TypeLabel sch ('TMap k v) r where + typeLensGet :: FieldValue sch ('TMap k v) -> r +typeLensGet (FMap Map (FieldValue sch k) (FieldValue sch v) +x) = (FieldValue sch k -> k') -> Map (FieldValue sch k) v' -> Map k' v' forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a mapKeys FieldValue sch k -> k' forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. @@ -452,10 +452,10 @@ FieldValue sch t -> r -> Map (FieldValue sch k) v' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Map (FieldValue sch k) (FieldValue sch v) -x) - typeLensSet :: r -> FieldValue sch ('TMap k v) -typeLensSet r -new = Map (FieldValue sch k) (FieldValue sch v) +x) + typeLensSet :: r -> FieldValue sch ('TMap k v) +typeLensSet r +new = Map (FieldValue sch k) (FieldValue sch v) -> FieldValue sch ('TMap k v) forall typeName fieldName (sch :: Schema typeName fieldName) (k :: FieldType typeName) (v :: FieldType typeName). @@ -478,26 +478,26 @@ r -> FieldValue sch t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> r Map k' v' -new)) +new)) -instance (r ~ NS (FieldValue sch) choices) - => TypeLabel sch ('TUnion choices) r where - typeLensGet :: FieldValue sch ('TUnion choices) -> r -typeLensGet (FUnion NS (FieldValue sch) choices -x) = r +instance (r ~ NS (FieldValue sch) choices) + => TypeLabel sch ('TUnion choices) r where + typeLensGet :: FieldValue sch ('TUnion choices) -> r +typeLensGet (FUnion NS (FieldValue sch) choices +x) = r NS (FieldValue sch) choices -x - typeLensSet :: r -> FieldValue sch ('TUnion choices) -typeLensSet = r -> FieldValue sch ('TUnion choices) +x + typeLensSet :: r -> FieldValue sch ('TUnion choices) +typeLensSet = r -> FieldValue sch ('TUnion choices) forall typeName fieldName (sch :: Schema typeName fieldName) (choices :: [FieldType typeName]). NS (FieldValue sch) choices -> FieldValue sch ('TUnion choices) FUnion -- | Build a Mu enumeration 'Term' from the name of the choice. -enum :: forall (choiceName :: Symbol) choices sch name. - EnumLabel choices choiceName - => Term sch ('DEnum name choices) +enum :: forall (choiceName :: Symbol) choices sch name. + EnumLabel choices choiceName + => Term sch ('DEnum name choices) enum :: Term sch ('DEnum name choices) enum = NS Proxy choices -> Term sch ('DEnum name choices) forall fieldName typeName (choices :: [ChoiceDef fieldName]) @@ -512,41 +512,41 @@ EnumLabel choices choiceName => Proxy choiceName -> NS Proxy choices enumPrismBuild (Proxy choiceName forall k (t :: k). Proxy t -Proxy @choiceName) +Proxy @choiceName) -- Useful utility to check whether a value -- matches a given enumeration choice. -- -- > f e | e `is` #sunny = ... -- > | e `is` #rainy = ... -is :: Is k An_AffineFold => s -> Optic' k is s a -> Bool +is :: Is k An_AffineFold => s -> Optic' k is s a -> Bool is :: s -> Optic' k is s a -> Bool -is s -s Optic' k is s a -k = Maybe a -> Bool +is s +s Optic' k is s a +k = Maybe a -> Bool forall a. Maybe a -> Bool isJust (Optic' k is s a -> s -> Maybe a forall k (is :: IxList) s a. Is k An_AffineFold => Optic' k is s a -> s -> Maybe a preview Optic' k is s a -k s -s) +k s +s) {-# INLINE is #-} -instance (EnumLabel choices choiceName, r ~ ()) - => LabelOptic choiceName A_Prism - (Term sch ('DEnum name choices)) - (Term sch ('DEnum name choices)) - r r where - labelOptic :: Optic +instance (EnumLabel choices choiceName, r ~ ()) + => LabelOptic choiceName A_Prism + (Term sch ('DEnum name choices)) + (Term sch ('DEnum name choices)) + r r where + labelOptic :: Optic A_Prism NoIx (Term sch ('DEnum name choices)) (Term sch ('DEnum name choices)) r r -labelOptic = (r -> Term sch ('DEnum name choices)) +labelOptic = (r -> Term sch ('DEnum name choices)) -> (Term sch ('DEnum name choices) -> Maybe r) -> Optic A_Prism @@ -570,44 +570,44 @@ EnumLabel choices choiceName => Proxy choiceName -> NS Proxy choices enumPrismBuild (Proxy choiceName forall k (t :: k). Proxy t -Proxy @choiceName)) - (\(TEnum NS Proxy choices -r) -> Proxy choiceName -> NS Proxy choices -> Maybe () +Proxy @choiceName)) + (\(TEnum NS Proxy choices +r) -> Proxy choiceName -> NS Proxy choices -> Maybe () forall (choices :: [ChoiceDef Symbol]) (choiceName :: Symbol). EnumLabel choices choiceName => Proxy choiceName -> NS Proxy choices -> Maybe () enumPrismMatch (Proxy choiceName forall k (t :: k). Proxy t -Proxy @choiceName) NS Proxy choices -r) +Proxy @choiceName) NS Proxy choices +r) -class EnumLabel (choices :: [ChoiceDef Symbol]) - (choiceName :: Symbol) where - enumPrismBuild :: Proxy choiceName -> NS Proxy choices - enumPrismMatch :: Proxy choiceName -> NS Proxy choices -> Maybe () +class EnumLabel (choices :: [ChoiceDef Symbol]) + (choiceName :: Symbol) where + enumPrismBuild :: Proxy choiceName -> NS Proxy choices + enumPrismMatch :: Proxy choiceName -> NS Proxy choices -> Maybe () -instance TypeError ('Text "cannot find choice " ':<>: 'ShowType c) - => EnumLabel '[] c where - enumPrismBuild :: Proxy c -> NS Proxy '[] -enumPrismBuild = [Char] -> Proxy c -> NS Proxy '[] +instance TypeError ('Text "cannot find choice " ':<>: 'ShowType c) + => EnumLabel '[] c where + enumPrismBuild :: Proxy c -> NS Proxy '[] +enumPrismBuild = [Char] -> Proxy c -> NS Proxy '[] forall a. HasCallStack => [Char] -> a error [Char] "this should never be run" - enumPrismMatch :: Proxy c -> NS Proxy '[] -> Maybe () -enumPrismMatch = [Char] -> Proxy c -> NS Proxy '[] -> Maybe () + enumPrismMatch :: Proxy c -> NS Proxy '[] -> Maybe () +enumPrismMatch = [Char] -> Proxy c -> NS Proxy '[] -> Maybe () forall a. HasCallStack => [Char] -> a error [Char] "this should never be run" -instance {-# OVERLAPS #-} EnumLabel ('ChoiceDef c ': rest) c where - enumPrismBuild :: Proxy c -> NS Proxy ('ChoiceDef c : rest) -enumPrismBuild Proxy c +instance {-# OVERLAPS #-} EnumLabel ('ChoiceDef c ': rest) c where + enumPrismBuild :: Proxy c -> NS Proxy ('ChoiceDef c : rest) +enumPrismBuild Proxy c _ = Proxy ('ChoiceDef c) -> NS Proxy ('ChoiceDef c : rest) forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs) Z Proxy ('ChoiceDef c) forall k (t :: k). Proxy t Proxy - enumPrismMatch :: Proxy c -> NS Proxy ('ChoiceDef c : rest) -> Maybe () -enumPrismMatch Proxy c + enumPrismMatch :: Proxy c -> NS Proxy ('ChoiceDef c : rest) -> Maybe () +enumPrismMatch Proxy c _ (Z Proxy x _) = () -> Maybe () forall a. a -> Maybe a @@ -617,11 +617,11 @@ forall a. a -> Maybe a _ = Maybe () forall a. Maybe a Nothing -instance {-# OVERLAPPABLE #-} EnumLabel rest c - => EnumLabel (d ': rest) c where - enumPrismBuild :: Proxy c -> NS Proxy (d : rest) -enumPrismBuild Proxy c -p = NS Proxy rest -> NS Proxy (d : rest) +instance {-# OVERLAPPABLE #-} EnumLabel rest c + => EnumLabel (d ': rest) c where + enumPrismBuild :: Proxy c -> NS Proxy (d : rest) +enumPrismBuild Proxy c +p = NS Proxy rest -> NS Proxy (d : rest) forall k (a :: k -> *) (xs :: [k]) (x :: k). NS a xs -> NS a (x : xs) S (Proxy c -> NS Proxy rest @@ -629,26 +629,26 @@ forall (choices :: [ChoiceDef Symbol]) (choiceName :: Symbol). EnumLabel choices choiceName => Proxy choiceName -> NS Proxy choices enumPrismBuild Proxy c -p) - enumPrismMatch :: Proxy c -> NS Proxy (d : rest) -> Maybe () -enumPrismMatch Proxy c +p) + enumPrismMatch :: Proxy c -> NS Proxy (d : rest) -> Maybe () +enumPrismMatch Proxy c _ (Z Proxy x _) = Maybe () forall a. Maybe a Nothing - enumPrismMatch Proxy c -p (S NS Proxy xs -x) = Proxy c -> NS Proxy xs -> Maybe () + enumPrismMatch Proxy c +p (S NS Proxy xs +x) = Proxy c -> NS Proxy xs -> Maybe () forall (choices :: [ChoiceDef Symbol]) (choiceName :: Symbol). EnumLabel choices choiceName => Proxy choiceName -> NS Proxy choices -> Maybe () enumPrismMatch Proxy c -p NS Proxy xs -x +p NS Proxy xs +x -- | Prism to access the first choice of a union. -_U0 :: forall (sch :: Schema') x xs r. TypeLabel sch x r - => Prism' (NS (FieldValue sch) (x ': xs)) r +_U0 :: forall (sch :: Schema') x xs r. TypeLabel sch x r + => Prism' (NS (FieldValue sch) (x ': xs)) r _U0 :: Prism' (NS (FieldValue sch) (x : xs)) r _U0 = (r -> NS (FieldValue sch) (x : xs)) -> (NS (FieldValue sch) (x : xs) -> Maybe r) @@ -664,8 +664,8 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => r -> FieldValue sch t typeLensSet) - (\case (Z FieldValue sch x -x) -> r -> Maybe r + (\case (Z FieldValue sch x +x) -> r -> Maybe r forall a. a -> Maybe a Just (r -> Maybe r) -> r -> Maybe r forall a b. (a -> b) -> a -> b @@ -674,7 +674,7 @@ forall (sch :: Schema Symbol Symbol) (t :: FieldType Symbol) r. TypeLabel sch t r => FieldValue sch t -> r typeLensGet FieldValue sch x -x +x (S NS (FieldValue sch) xs _) -> Maybe r forall a. Maybe a @@ -686,9 +686,9 @@ forall a. Maybe a -- with '_U0'. -- -- > _Next % _Next % _U0 -- access third choice -_Next :: forall (sch :: Schema') x xs. - Prism' (NS (FieldValue sch) (x ': xs)) - (NS (FieldValue sch) xs) +_Next :: forall (sch :: Schema') x xs. + Prism' (NS (FieldValue sch) (x ': xs)) + (NS (FieldValue sch) xs) _Next :: Prism' (NS (FieldValue sch) (x : xs)) (NS (FieldValue sch) xs) _Next = (NS (FieldValue sch) xs -> NS (FieldValue sch) (x : xs)) -> (NS (FieldValue sch) (x : xs) -> Maybe (NS (FieldValue sch) xs)) @@ -702,15 +702,15 @@ NS a xs -> NS a (x : xs) _) -> Maybe (NS (FieldValue sch) xs) forall a. Maybe a Nothing - (S NS (FieldValue sch) xs -x) -> NS (FieldValue sch) xs -> Maybe (NS (FieldValue sch) xs) + (S NS (FieldValue sch) xs +x) -> NS (FieldValue sch) xs -> Maybe (NS (FieldValue sch) xs) forall a. a -> Maybe a Just NS (FieldValue sch) xs -x) +x) -- | Prism to access the second choice of a union. -_U1 :: forall (sch :: Schema') a b xs r. TypeLabel sch b r - => Prism' (NS (FieldValue sch) (a ': b ': xs)) r +_U1 :: forall (sch :: Schema') a b xs r. TypeLabel sch b r + => Prism' (NS (FieldValue sch) (a ': b ': xs)) r _U1 :: Prism' (NS (FieldValue sch) (a : b : xs)) r _U1 = Prism' (NS (FieldValue sch) (a : b : xs)) (NS (FieldValue sch) (b : xs)) @@ -745,8 +745,8 @@ Prism' (NS (FieldValue sch) (x : xs)) r _U0 -- | Prism to access the third choice of a union. -_U2 :: forall (sch :: Schema') a b c xs r. TypeLabel sch c r - => Prism' (NS (FieldValue sch) (a ': b ': c ': xs)) r +_U2 :: forall (sch :: Schema') a b c xs r. TypeLabel sch c r + => Prism' (NS (FieldValue sch) (a ': b ': c ': xs)) r _U2 :: Prism' (NS (FieldValue sch) (a : b : c : xs)) r _U2 = Prism' (NS (FieldValue sch) (a : b : c : xs)) @@ -783,8 +783,8 @@ Prism' (NS (FieldValue sch) (a : b : xs)) r _U1 -- | Prism to access the fourth choice of a union. -_U3 :: forall (sch :: Schema') a b c d xs r. TypeLabel sch d r - => Prism' (NS (FieldValue sch) (a ': b ': c ': d ': xs)) r +_U3 :: forall (sch :: Schema') a b c d xs r. TypeLabel sch d r + => Prism' (NS (FieldValue sch) (a ': b ': c ': d ': xs)) r _U3 :: Prism' (NS (FieldValue sch) (a : b : c : d : xs)) r _U3 = Prism' (NS (FieldValue sch) (a : b : c : d : xs)) diff --git a/wip/haddock/mu-persistent/mu-persistent.haddock b/wip/haddock/mu-persistent/mu-persistent.haddock index f63fd75..fedb7cb 100644 Binary files a/wip/haddock/mu-persistent/mu-persistent.haddock and b/wip/haddock/mu-persistent/mu-persistent.haddock differ diff --git a/wip/haddock/mu-prometheus/mu-prometheus.haddock b/wip/haddock/mu-prometheus/mu-prometheus.haddock index 0da8f80..047b8c8 100644 Binary files a/wip/haddock/mu-prometheus/mu-prometheus.haddock and b/wip/haddock/mu-prometheus/mu-prometheus.haddock differ diff --git a/wip/haddock/mu-protobuf/mu-protobuf.haddock b/wip/haddock/mu-protobuf/mu-protobuf.haddock index fbaf553..dd102ad 100644 Binary files a/wip/haddock/mu-protobuf/mu-protobuf.haddock and b/wip/haddock/mu-protobuf/mu-protobuf.haddock differ diff --git a/wip/haddock/mu-rpc/Mu-Rpc-Examples.html b/wip/haddock/mu-rpc/Mu-Rpc-Examples.html index 4219035..b6979b4 100644 --- a/wip/haddock/mu-rpc/Mu-Rpc-Examples.html +++ b/wip/haddock/mu-rpc/Mu-Rpc-Examples.html @@ -1 +1 @@ -Mu.Rpc.Examples

mu-rpc-0.5.0.1: Protocol-independent declaration of services and servers.
Safe HaskellNone
LanguageHaskell2010

Mu.Rpc.Examples

Description

Look at the source code of this module.

Documentation

type QuickstartSchema = '['DRecord "HelloRequest" '['FieldDef "name" ('TPrimitive Text)], 'DRecord "HelloResponse" '['FieldDef "message" ('TPrimitive Text)], 'DRecord "HiRequest" '['FieldDef "number" ('TPrimitive Int)]] Source #

type QuickStartService = 'Package ('Just "helloworld") '['Service "Greeter" '['Method "SayHello" '['ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HelloRequest")] ('RetSingle ('SchemaRef QuickstartSchema "HelloResponse")), 'Method "SayHi" '['ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HiRequest")] ('RetStream ('SchemaRef QuickstartSchema "HelloResponse")), 'Method "SayManyHellos" '['ArgStream ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HelloRequest")] ('RetStream ('SchemaRef QuickstartSchema "HelloResponse"))]] :: Package' Source #

newtype HelloRequest Source #

Constructors

HelloRequest 

Fields

Instances

Instances details
Eq HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

(==) :: HelloRequest -> HelloRequest -> Bool #

(/=) :: HelloRequest -> HelloRequest -> Bool #

Show HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

showsPrec :: Int -> HelloRequest -> ShowS #

show :: HelloRequest -> String #

showList :: [HelloRequest] -> ShowS #

Generic HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Associated Types

type Rep HelloRequest :: Type -> Type #

Methods

from :: HelloRequest -> Rep HelloRequest x #

to :: Rep HelloRequest x -> HelloRequest #

FromJSON HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

parseJSON :: Value -> Parser HelloRequest

parseJSONList :: Value -> Parser [HelloRequest]

ToJSON HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toJSON :: HelloRequest -> Value

toEncoding :: HelloRequest -> Encoding

toJSONList :: [HelloRequest] -> Value

toEncodingList :: [HelloRequest] -> Encoding

FromSchema QuickstartSchema "HelloRequest" HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

fromSchema :: Term QuickstartSchema (QuickstartSchema :/: "HelloRequest") -> HelloRequest

ToSchema QuickstartSchema "HelloRequest" HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toSchema :: HelloRequest -> Term QuickstartSchema (QuickstartSchema :/: "HelloRequest")

type Rep HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

type Rep HelloRequest = D1 ('MetaData "HelloRequest" "Mu.Rpc.Examples" "mu-rpc-0.5.0.1-934YgupfAtxLCRRpTImop6" 'True) (C1 ('MetaCons "HelloRequest" 'PrefixI 'True) (S1 ('MetaSel ('Just "name") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

newtype HelloResponse Source #

Constructors

HelloResponse 

Fields

Instances

Instances details
Eq HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

(==) :: HelloResponse -> HelloResponse -> Bool #

(/=) :: HelloResponse -> HelloResponse -> Bool #

Show HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

showsPrec :: Int -> HelloResponse -> ShowS #

show :: HelloResponse -> String #

showList :: [HelloResponse] -> ShowS #

Generic HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Associated Types

type Rep HelloResponse :: Type -> Type #

Methods

from :: HelloResponse -> Rep HelloResponse x #

to :: Rep HelloResponse x -> HelloResponse #

FromJSON HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

parseJSON :: Value -> Parser HelloResponse

parseJSONList :: Value -> Parser [HelloResponse]

ToJSON HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toJSON :: HelloResponse -> Value

toEncoding :: HelloResponse -> Encoding

toJSONList :: [HelloResponse] -> Value

toEncodingList :: [HelloResponse] -> Encoding

FromSchema QuickstartSchema "HelloResponse" HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

fromSchema :: Term QuickstartSchema (QuickstartSchema :/: "HelloResponse") -> HelloResponse

ToSchema QuickstartSchema "HelloResponse" HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toSchema :: HelloResponse -> Term QuickstartSchema (QuickstartSchema :/: "HelloResponse")

type Rep HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

type Rep HelloResponse = D1 ('MetaData "HelloResponse" "Mu.Rpc.Examples" "mu-rpc-0.5.0.1-934YgupfAtxLCRRpTImop6" 'True) (C1 ('MetaCons "HelloResponse" 'PrefixI 'True) (S1 ('MetaSel ('Just "message") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

newtype HiRequest Source #

Constructors

HiRequest 

Fields

Instances

Instances details
Eq HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

(==) :: HiRequest -> HiRequest -> Bool #

(/=) :: HiRequest -> HiRequest -> Bool #

Show HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

showsPrec :: Int -> HiRequest -> ShowS #

show :: HiRequest -> String #

showList :: [HiRequest] -> ShowS #

Generic HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Associated Types

type Rep HiRequest :: Type -> Type #

Methods

from :: HiRequest -> Rep HiRequest x #

to :: Rep HiRequest x -> HiRequest #

FromJSON HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

parseJSON :: Value -> Parser HiRequest

parseJSONList :: Value -> Parser [HiRequest]

ToJSON HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toJSON :: HiRequest -> Value

toEncoding :: HiRequest -> Encoding

toJSONList :: [HiRequest] -> Value

toEncodingList :: [HiRequest] -> Encoding

FromSchema QuickstartSchema "HiRequest" HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

fromSchema :: Term QuickstartSchema (QuickstartSchema :/: "HiRequest") -> HiRequest

ToSchema QuickstartSchema "HiRequest" HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toSchema :: HiRequest -> Term QuickstartSchema (QuickstartSchema :/: "HiRequest")

type Rep HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

type Rep HiRequest = D1 ('MetaData "HiRequest" "Mu.Rpc.Examples" "mu-rpc-0.5.0.1-934YgupfAtxLCRRpTImop6" 'True) (C1 ('MetaCons "HiRequest" 'PrefixI 'True) (S1 ('MetaSel ('Just "number") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

quickstartServer :: forall m i. MonadServer m => ServerT '[] i QuickStartService m _ Source #

type ApolloService = 'Package ('Just "apollo") '[Object "Book" '[ObjectField "title" '[] ('RetSingle ('PrimitiveRef String)), ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))], Object "Paper" '[ObjectField "title" '[] ('RetSingle ('PrimitiveRef String)), ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))], Union "Writing" ["Book", "Paper"], Object "Author" '[ObjectField "name" '[] ('RetSingle ('PrimitiveRef String)), ObjectField "writings" '[] ('RetSingle ('ListRef ('ObjectRef "Writing")))]] Source #

type ApolloBookAuthor = '["Book" :-> (String, Integer), "Paper" :-> (String, Integer), "Writing" :-> Either (String, Integer) (String, Integer), "Author" :-> Integer] Source #

apolloServer :: forall m i. MonadServer m => ServerT ApolloBookAuthor i ApolloService m _ Source #

\ No newline at end of file +Mu.Rpc.Examples
mu-rpc-0.5.0.1: Protocol-independent declaration of services and servers.
Safe HaskellNone
LanguageHaskell2010

Mu.Rpc.Examples

Description

Look at the source code of this module.

Documentation

type QuickstartSchema = '['DRecord "HelloRequest" '['FieldDef "name" ('TPrimitive Text)], 'DRecord "HelloResponse" '['FieldDef "message" ('TPrimitive Text)], 'DRecord "HiRequest" '['FieldDef "number" ('TPrimitive Int)]] Source #

type QuickStartService = 'Package ('Just "helloworld") '['Service "Greeter" '['Method "SayHello" '['ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HelloRequest")] ('RetSingle ('SchemaRef QuickstartSchema "HelloResponse")), 'Method "SayHi" '['ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HiRequest")] ('RetStream ('SchemaRef QuickstartSchema "HelloResponse")), 'Method "SayManyHellos" '['ArgStream ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HelloRequest")] ('RetStream ('SchemaRef QuickstartSchema "HelloResponse"))]] :: Package' Source #

newtype HelloRequest Source #

Constructors

HelloRequest 

Fields

Instances

Instances details
Eq HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

(==) :: HelloRequest -> HelloRequest -> Bool #

(/=) :: HelloRequest -> HelloRequest -> Bool #

Show HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

showsPrec :: Int -> HelloRequest -> ShowS #

show :: HelloRequest -> String #

showList :: [HelloRequest] -> ShowS #

Generic HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Associated Types

type Rep HelloRequest :: Type -> Type #

Methods

from :: HelloRequest -> Rep HelloRequest x #

to :: Rep HelloRequest x -> HelloRequest #

FromJSON HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

parseJSON :: Value -> Parser HelloRequest

parseJSONList :: Value -> Parser [HelloRequest]

ToJSON HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toJSON :: HelloRequest -> Value

toEncoding :: HelloRequest -> Encoding

toJSONList :: [HelloRequest] -> Value

toEncodingList :: [HelloRequest] -> Encoding

FromSchema QuickstartSchema "HelloRequest" HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

fromSchema :: Term QuickstartSchema (QuickstartSchema :/: "HelloRequest") -> HelloRequest

ToSchema QuickstartSchema "HelloRequest" HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toSchema :: HelloRequest -> Term QuickstartSchema (QuickstartSchema :/: "HelloRequest")

type Rep HelloRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

type Rep HelloRequest = D1 ('MetaData "HelloRequest" "Mu.Rpc.Examples" "mu-rpc-0.5.0.1-H9KRzaNWPg9EIMZTZbAznO" 'True) (C1 ('MetaCons "HelloRequest" 'PrefixI 'True) (S1 ('MetaSel ('Just "name") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

newtype HelloResponse Source #

Constructors

HelloResponse 

Fields

Instances

Instances details
Eq HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

(==) :: HelloResponse -> HelloResponse -> Bool #

(/=) :: HelloResponse -> HelloResponse -> Bool #

Show HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

showsPrec :: Int -> HelloResponse -> ShowS #

show :: HelloResponse -> String #

showList :: [HelloResponse] -> ShowS #

Generic HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Associated Types

type Rep HelloResponse :: Type -> Type #

Methods

from :: HelloResponse -> Rep HelloResponse x #

to :: Rep HelloResponse x -> HelloResponse #

FromJSON HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

parseJSON :: Value -> Parser HelloResponse

parseJSONList :: Value -> Parser [HelloResponse]

ToJSON HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toJSON :: HelloResponse -> Value

toEncoding :: HelloResponse -> Encoding

toJSONList :: [HelloResponse] -> Value

toEncodingList :: [HelloResponse] -> Encoding

FromSchema QuickstartSchema "HelloResponse" HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

fromSchema :: Term QuickstartSchema (QuickstartSchema :/: "HelloResponse") -> HelloResponse

ToSchema QuickstartSchema "HelloResponse" HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toSchema :: HelloResponse -> Term QuickstartSchema (QuickstartSchema :/: "HelloResponse")

type Rep HelloResponse Source # 
Instance details

Defined in Mu.Rpc.Examples

type Rep HelloResponse = D1 ('MetaData "HelloResponse" "Mu.Rpc.Examples" "mu-rpc-0.5.0.1-H9KRzaNWPg9EIMZTZbAznO" 'True) (C1 ('MetaCons "HelloResponse" 'PrefixI 'True) (S1 ('MetaSel ('Just "message") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

newtype HiRequest Source #

Constructors

HiRequest 

Fields

Instances

Instances details
Eq HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

(==) :: HiRequest -> HiRequest -> Bool #

(/=) :: HiRequest -> HiRequest -> Bool #

Show HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

showsPrec :: Int -> HiRequest -> ShowS #

show :: HiRequest -> String #

showList :: [HiRequest] -> ShowS #

Generic HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Associated Types

type Rep HiRequest :: Type -> Type #

Methods

from :: HiRequest -> Rep HiRequest x #

to :: Rep HiRequest x -> HiRequest #

FromJSON HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

parseJSON :: Value -> Parser HiRequest

parseJSONList :: Value -> Parser [HiRequest]

ToJSON HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toJSON :: HiRequest -> Value

toEncoding :: HiRequest -> Encoding

toJSONList :: [HiRequest] -> Value

toEncodingList :: [HiRequest] -> Encoding

FromSchema QuickstartSchema "HiRequest" HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

fromSchema :: Term QuickstartSchema (QuickstartSchema :/: "HiRequest") -> HiRequest

ToSchema QuickstartSchema "HiRequest" HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

Methods

toSchema :: HiRequest -> Term QuickstartSchema (QuickstartSchema :/: "HiRequest")

type Rep HiRequest Source # 
Instance details

Defined in Mu.Rpc.Examples

type Rep HiRequest = D1 ('MetaData "HiRequest" "Mu.Rpc.Examples" "mu-rpc-0.5.0.1-H9KRzaNWPg9EIMZTZbAznO" 'True) (C1 ('MetaCons "HiRequest" 'PrefixI 'True) (S1 ('MetaSel ('Just "number") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)))

quickstartServer :: forall m i. MonadServer m => ServerT '[] i QuickStartService m _ Source #

type ApolloService = 'Package ('Just "apollo") '[Object "Book" '[ObjectField "title" '[] ('RetSingle ('PrimitiveRef String)), ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))], Object "Paper" '[ObjectField "title" '[] ('RetSingle ('PrimitiveRef String)), ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))], Union "Writing" ["Book", "Paper"], Object "Author" '[ObjectField "name" '[] ('RetSingle ('PrimitiveRef String)), ObjectField "writings" '[] ('RetSingle ('ListRef ('ObjectRef "Writing")))]] Source #

type ApolloBookAuthor = '["Book" :-> (String, Integer), "Paper" :-> (String, Integer), "Writing" :-> Either (String, Integer) (String, Integer), "Author" :-> Integer] Source #

apolloServer :: forall m i. MonadServer m => ServerT ApolloBookAuthor i ApolloService m _ Source #

\ No newline at end of file diff --git a/wip/haddock/mu-rpc/mu-rpc.haddock b/wip/haddock/mu-rpc/mu-rpc.haddock index ddb004e..75ed038 100644 Binary files a/wip/haddock/mu-rpc/mu-rpc.haddock and b/wip/haddock/mu-rpc/mu-rpc.haddock differ diff --git a/wip/haddock/mu-schema/Mu-Schema-Examples.html b/wip/haddock/mu-schema/Mu-Schema-Examples.html index 45ef69a..a665047 100644 --- a/wip/haddock/mu-schema/Mu-Schema-Examples.html +++ b/wip/haddock/mu-schema/Mu-Schema-Examples.html @@ -1 +1 @@ -Mu.Schema.Examples
mu-schema-0.3.1.2: Format-independent schemas for serialization
Safe HaskellNone
LanguageHaskell2010

Mu.Schema.Examples

Description

Look at the source code of this module.

Documentation

data Person Source #

Constructors

Person 

Fields

Instances

Instances details
Eq Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: Person -> Person -> Bool #

(/=) :: Person -> Person -> Bool #

Show Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> Person -> ShowS #

show :: Person -> String #

showList :: [Person] -> ShowS #

Generic Person Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep Person :: Type -> Type #

Methods

from :: Person -> Rep Person x #

to :: Rep Person x -> Person #

FromJSON Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

parseJSON :: Value -> Parser Person

parseJSONList :: Value -> Parser [Person]

ToJSON Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toJSON :: Person -> Value

toEncoding :: Person -> Encoding

toJSONList :: [Person] -> Value

toEncodingList :: [Person] -> Encoding

FromSchema ExampleSchema "person" Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

fromSchema :: Term ExampleSchema (ExampleSchema :/: "person") -> Person Source #

ToSchema ExampleSchema "person" Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toSchema :: Person -> Term ExampleSchema (ExampleSchema :/: "person") Source #

type Rep Person Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep Person = D1 ('MetaData "Person" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6ZbNPrQ4rjF7GfWXADrjPp" 'False) (C1 ('MetaCons "Person" 'PrefixI 'True) ((S1 ('MetaSel ('Just "firstName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Just "lastName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "age") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Int)))) :*: ((S1 ('MetaSel ('Just "gender") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Gender) :*: S1 ('MetaSel ('Just "address") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Address)) :*: (S1 ('MetaSel ('Just "lucky_numbers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Int]) :*: S1 ('MetaSel ('Just "things") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text Int))))))

data Address Source #

Constructors

Address 

Fields

Instances

Instances details
Eq Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: Address -> Address -> Bool #

(/=) :: Address -> Address -> Bool #

Show Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> Address -> ShowS #

show :: Address -> String #

showList :: [Address] -> ShowS #

Generic Address Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep Address :: Type -> Type #

Methods

from :: Address -> Rep Address x #

to :: Rep Address x -> Address #

FromJSON Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

parseJSON :: Value -> Parser Address

parseJSONList :: Value -> Parser [Address]

ToJSON Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toJSON :: Address -> Value

toEncoding :: Address -> Encoding

toJSONList :: [Address] -> Value

toEncodingList :: [Address] -> Encoding

FromSchema ExampleSchema "address" Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

fromSchema :: Term ExampleSchema (ExampleSchema :/: "address") -> Address Source #

ToSchema ExampleSchema "address" Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toSchema :: Address -> Term ExampleSchema (ExampleSchema :/: "address") Source #

type Rep Address Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep Address = D1 ('MetaData "Address" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6ZbNPrQ4rjF7GfWXADrjPp" 'False) (C1 ('MetaCons "Address" 'PrefixI 'True) (S1 ('MetaSel ('Just "postcode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "country") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

type GenderFieldMapping = '["Male" :-> "male", "Female" :-> "female", "NonBinary" :-> "nb", "Gender0" :-> "gender0", "Gender1" :-> "gender1", "Gender2" :-> "gender2", "Gender3" :-> "gender3", "Gender4" :-> "gender4", "Gender5" :-> "gender5", "Gender6" :-> "gender6", "Gender7" :-> "gender7", "Gender8" :-> "gender8", "Gender9" :-> "gender9", "Unspecified" :-> "unspecified"] Source #

data Gender Source #

Constructors

Male 
Female 
NonBinary 
Gender0 
Gender1 
Gender2 
Gender3 
Gender4 
Gender5 
Gender6 
Gender7 
Gender8 
Gender9 
Unspecified 

Instances

Instances details
Eq Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: Gender -> Gender -> Bool #

(/=) :: Gender -> Gender -> Bool #

Show Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> Gender -> ShowS #

show :: Gender -> String #

showList :: [Gender] -> ShowS #

Generic Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep Gender :: Type -> Type #

Methods

from :: Gender -> Rep Gender x #

to :: Rep Gender x -> Gender #

FromJSON Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

parseJSON :: Value -> Parser Gender

parseJSONList :: Value -> Parser [Gender]

ToJSON Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toJSON :: Gender -> Value

toEncoding :: Gender -> Encoding

toJSONList :: [Gender] -> Value

toEncodingList :: [Gender] -> Encoding

FromSchema ExampleSchema "gender" Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

fromSchema :: Term ExampleSchema (ExampleSchema :/: "gender") -> Gender Source #

ToSchema ExampleSchema "gender" Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toSchema :: Gender -> Term ExampleSchema (ExampleSchema :/: "gender") Source #

type Rep Gender Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep Gender = D1 ('MetaData "Gender" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6ZbNPrQ4rjF7GfWXADrjPp" 'False) (((C1 ('MetaCons "Male" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Female" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NonBinary" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Gender0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Gender2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender3" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "Gender4" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Gender5" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender6" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Gender7" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender8" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Gender9" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Unspecified" 'PrefixI 'False) (U1 :: Type -> Type)))))

type ExampleSchema = '['DEnum "gender" '['ChoiceDef "male", 'ChoiceDef "female", 'ChoiceDef "nb", 'ChoiceDef "gender0", 'ChoiceDef "gender1", 'ChoiceDef "gender2", 'ChoiceDef "gender3", 'ChoiceDef "gender4", 'ChoiceDef "gender5", 'ChoiceDef "gender6", 'ChoiceDef "gender7", 'ChoiceDef "gender8", 'ChoiceDef "gender9", 'ChoiceDef "unspecified"], 'DRecord "address" '['FieldDef "postcode" ('TPrimitive Text), 'FieldDef "country" ('TPrimitive Text)], 'DRecord "person" '['FieldDef "firstName" ('TPrimitive Text), 'FieldDef "lastName" ('TPrimitive Text), 'FieldDef "age" ('TOption ('TPrimitive Int)), 'FieldDef "gender" ('TSchematic "gender"), 'FieldDef "address" ('TSchematic "address"), 'FieldDef "lucky_numbers" ('TList ('TPrimitive Int)), 'FieldDef "things" ('TMap ('TPrimitive Text) ('TPrimitive Int))]] Source #

data GenderMsg f Source #

Constructors

GenderMsgMale 
GenderMsgFemale 
GenderMsgNb 
GenderMsgGender0 
GenderMsgGender1 
GenderMsgGender2 
GenderMsgGender3 
GenderMsgGender4 
GenderMsgGender5 
GenderMsgGender6 
GenderMsgGender7 
GenderMsgGender8 
GenderMsgGender9 
GenderMsgUnspecified 

Instances

Instances details
Eq (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: GenderMsg f -> GenderMsg f -> Bool #

(/=) :: GenderMsg f -> GenderMsg f -> Bool #

Ord (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

compare :: GenderMsg f -> GenderMsg f -> Ordering #

(<) :: GenderMsg f -> GenderMsg f -> Bool #

(<=) :: GenderMsg f -> GenderMsg f -> Bool #

(>) :: GenderMsg f -> GenderMsg f -> Bool #

(>=) :: GenderMsg f -> GenderMsg f -> Bool #

max :: GenderMsg f -> GenderMsg f -> GenderMsg f #

min :: GenderMsg f -> GenderMsg f -> GenderMsg f #

Show (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> GenderMsg f -> ShowS #

show :: GenderMsg f -> String #

showList :: [GenderMsg f] -> ShowS #

Generic (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep (GenderMsg f) :: Type -> Type #

Methods

from :: GenderMsg f -> Rep (GenderMsg f) x #

to :: Rep (GenderMsg f) x -> GenderMsg f #

type Rep (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep (GenderMsg f) = D1 ('MetaData "GenderMsg" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6ZbNPrQ4rjF7GfWXADrjPp" 'False) (((C1 ('MetaCons "GenderMsgMale" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "GenderMsgFemale" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgNb" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GenderMsgGender0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GenderMsgGender2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender3" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "GenderMsgGender4" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "GenderMsgGender5" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender6" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GenderMsgGender7" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender8" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GenderMsgGender9" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgUnspecified" 'PrefixI 'False) (U1 :: Type -> Type)))))

data AddressMsg f Source #

Constructors

AddressMsg 

Fields

Instances

Instances details
Generic (AddressMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep (AddressMsg f) :: Type -> Type #

Methods

from :: AddressMsg f -> Rep (AddressMsg f) x #

to :: Rep (AddressMsg f) x -> AddressMsg f #

type Rep (AddressMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep (AddressMsg f) = D1 ('MetaData "AddressMsg" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6ZbNPrQ4rjF7GfWXADrjPp" 'False) (C1 ('MetaCons "AddressMsg" 'PrefixI 'True) (S1 ('MetaSel ('Just "addressMsgPostcode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text)) :*: S1 ('MetaSel ('Just "addressMsgCountry") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text))))

data PersonMsg f Source #

Constructors

PersonMsg 

Fields

Instances

Instances details
Generic (PersonMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep (PersonMsg f) :: Type -> Type #

Methods

from :: PersonMsg f -> Rep (PersonMsg f) x #

to :: Rep (PersonMsg f) x -> PersonMsg f #

type Rep (PersonMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep (PersonMsg f) = D1 ('MetaData "PersonMsg" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6ZbNPrQ4rjF7GfWXADrjPp" 'False) (C1 ('MetaCons "PersonMsg" 'PrefixI 'True) ((S1 ('MetaSel ('Just "personMsgFirstName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text)) :*: (S1 ('MetaSel ('Just "personMsgLastName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text)) :*: S1 ('MetaSel ('Just "personMsgAge") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Maybe Int))))) :*: ((S1 ('MetaSel ('Just "personMsgGender") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (GenderMsg f))) :*: S1 ('MetaSel ('Just "personMsgAddress") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (AddressMsg f)))) :*: (S1 ('MetaSel ('Just "personMsgLucky_numbers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f [Int])) :*: S1 ('MetaSel ('Just "personMsgThings") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Map Text Int)))))))

type ExampleSchema2 = '['DEnum "gender" '['ChoiceDef "Male", 'ChoiceDef "Female", 'ChoiceDef "NonBinary"], 'DRecord "address" '['FieldDef "postcode" ('TPrimitive Text), 'FieldDef "country" ('TPrimitive Text)], 'DRecord "person" '['FieldDef "firstName" ('TPrimitive Text), 'FieldDef "lastName" ('TPrimitive Text), 'FieldDef "age" ('TOption ('TPrimitive Int)), 'FieldDef "gender" ('TOption ('TSchematic "gender")), 'FieldDef "address" ('TSchematic "address")]] Source #

type ExampleRegistry = '[2 :-> ExampleSchema2, 1 :-> ExampleSchema] Source #

\ No newline at end of file +Mu.Schema.Examples
mu-schema-0.3.1.2: Format-independent schemas for serialization
Safe HaskellNone
LanguageHaskell2010

Mu.Schema.Examples

Description

Look at the source code of this module.

Documentation

data Person Source #

Constructors

Person 

Fields

Instances

Instances details
Eq Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: Person -> Person -> Bool #

(/=) :: Person -> Person -> Bool #

Show Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> Person -> ShowS #

show :: Person -> String #

showList :: [Person] -> ShowS #

Generic Person Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep Person :: Type -> Type #

Methods

from :: Person -> Rep Person x #

to :: Rep Person x -> Person #

FromJSON Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

parseJSON :: Value -> Parser Person

parseJSONList :: Value -> Parser [Person]

ToJSON Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toJSON :: Person -> Value

toEncoding :: Person -> Encoding

toJSONList :: [Person] -> Value

toEncodingList :: [Person] -> Encoding

FromSchema ExampleSchema "person" Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

fromSchema :: Term ExampleSchema (ExampleSchema :/: "person") -> Person Source #

ToSchema ExampleSchema "person" Person Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toSchema :: Person -> Term ExampleSchema (ExampleSchema :/: "person") Source #

type Rep Person Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep Person = D1 ('MetaData "Person" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6VfB3GnT9m1A7cm1PjPj6A" 'False) (C1 ('MetaCons "Person" 'PrefixI 'True) ((S1 ('MetaSel ('Just "firstName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Just "lastName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "age") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Int)))) :*: ((S1 ('MetaSel ('Just "gender") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Gender) :*: S1 ('MetaSel ('Just "address") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Address)) :*: (S1 ('MetaSel ('Just "lucky_numbers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Int]) :*: S1 ('MetaSel ('Just "things") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text Int))))))

data Address Source #

Constructors

Address 

Fields

Instances

Instances details
Eq Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: Address -> Address -> Bool #

(/=) :: Address -> Address -> Bool #

Show Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> Address -> ShowS #

show :: Address -> String #

showList :: [Address] -> ShowS #

Generic Address Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep Address :: Type -> Type #

Methods

from :: Address -> Rep Address x #

to :: Rep Address x -> Address #

FromJSON Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

parseJSON :: Value -> Parser Address

parseJSONList :: Value -> Parser [Address]

ToJSON Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toJSON :: Address -> Value

toEncoding :: Address -> Encoding

toJSONList :: [Address] -> Value

toEncodingList :: [Address] -> Encoding

FromSchema ExampleSchema "address" Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

fromSchema :: Term ExampleSchema (ExampleSchema :/: "address") -> Address Source #

ToSchema ExampleSchema "address" Address Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toSchema :: Address -> Term ExampleSchema (ExampleSchema :/: "address") Source #

type Rep Address Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep Address = D1 ('MetaData "Address" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6VfB3GnT9m1A7cm1PjPj6A" 'False) (C1 ('MetaCons "Address" 'PrefixI 'True) (S1 ('MetaSel ('Just "postcode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "country") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

type GenderFieldMapping = '["Male" :-> "male", "Female" :-> "female", "NonBinary" :-> "nb", "Gender0" :-> "gender0", "Gender1" :-> "gender1", "Gender2" :-> "gender2", "Gender3" :-> "gender3", "Gender4" :-> "gender4", "Gender5" :-> "gender5", "Gender6" :-> "gender6", "Gender7" :-> "gender7", "Gender8" :-> "gender8", "Gender9" :-> "gender9", "Unspecified" :-> "unspecified"] Source #

data Gender Source #

Constructors

Male 
Female 
NonBinary 
Gender0 
Gender1 
Gender2 
Gender3 
Gender4 
Gender5 
Gender6 
Gender7 
Gender8 
Gender9 
Unspecified 

Instances

Instances details
Eq Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: Gender -> Gender -> Bool #

(/=) :: Gender -> Gender -> Bool #

Show Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> Gender -> ShowS #

show :: Gender -> String #

showList :: [Gender] -> ShowS #

Generic Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep Gender :: Type -> Type #

Methods

from :: Gender -> Rep Gender x #

to :: Rep Gender x -> Gender #

FromJSON Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

parseJSON :: Value -> Parser Gender

parseJSONList :: Value -> Parser [Gender]

ToJSON Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toJSON :: Gender -> Value

toEncoding :: Gender -> Encoding

toJSONList :: [Gender] -> Value

toEncodingList :: [Gender] -> Encoding

FromSchema ExampleSchema "gender" Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

fromSchema :: Term ExampleSchema (ExampleSchema :/: "gender") -> Gender Source #

ToSchema ExampleSchema "gender" Gender Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

toSchema :: Gender -> Term ExampleSchema (ExampleSchema :/: "gender") Source #

type Rep Gender Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep Gender = D1 ('MetaData "Gender" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6VfB3GnT9m1A7cm1PjPj6A" 'False) (((C1 ('MetaCons "Male" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Female" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NonBinary" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Gender0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Gender2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender3" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "Gender4" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Gender5" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender6" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Gender7" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gender8" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Gender9" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Unspecified" 'PrefixI 'False) (U1 :: Type -> Type)))))

type ExampleSchema = '['DEnum "gender" '['ChoiceDef "male", 'ChoiceDef "female", 'ChoiceDef "nb", 'ChoiceDef "gender0", 'ChoiceDef "gender1", 'ChoiceDef "gender2", 'ChoiceDef "gender3", 'ChoiceDef "gender4", 'ChoiceDef "gender5", 'ChoiceDef "gender6", 'ChoiceDef "gender7", 'ChoiceDef "gender8", 'ChoiceDef "gender9", 'ChoiceDef "unspecified"], 'DRecord "address" '['FieldDef "postcode" ('TPrimitive Text), 'FieldDef "country" ('TPrimitive Text)], 'DRecord "person" '['FieldDef "firstName" ('TPrimitive Text), 'FieldDef "lastName" ('TPrimitive Text), 'FieldDef "age" ('TOption ('TPrimitive Int)), 'FieldDef "gender" ('TSchematic "gender"), 'FieldDef "address" ('TSchematic "address"), 'FieldDef "lucky_numbers" ('TList ('TPrimitive Int)), 'FieldDef "things" ('TMap ('TPrimitive Text) ('TPrimitive Int))]] Source #

data GenderMsg f Source #

Constructors

GenderMsgMale 
GenderMsgFemale 
GenderMsgNb 
GenderMsgGender0 
GenderMsgGender1 
GenderMsgGender2 
GenderMsgGender3 
GenderMsgGender4 
GenderMsgGender5 
GenderMsgGender6 
GenderMsgGender7 
GenderMsgGender8 
GenderMsgGender9 
GenderMsgUnspecified 

Instances

Instances details
Eq (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

(==) :: GenderMsg f -> GenderMsg f -> Bool #

(/=) :: GenderMsg f -> GenderMsg f -> Bool #

Ord (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

compare :: GenderMsg f -> GenderMsg f -> Ordering #

(<) :: GenderMsg f -> GenderMsg f -> Bool #

(<=) :: GenderMsg f -> GenderMsg f -> Bool #

(>) :: GenderMsg f -> GenderMsg f -> Bool #

(>=) :: GenderMsg f -> GenderMsg f -> Bool #

max :: GenderMsg f -> GenderMsg f -> GenderMsg f #

min :: GenderMsg f -> GenderMsg f -> GenderMsg f #

Show (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Methods

showsPrec :: Int -> GenderMsg f -> ShowS #

show :: GenderMsg f -> String #

showList :: [GenderMsg f] -> ShowS #

Generic (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep (GenderMsg f) :: Type -> Type #

Methods

from :: GenderMsg f -> Rep (GenderMsg f) x #

to :: Rep (GenderMsg f) x -> GenderMsg f #

type Rep (GenderMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep (GenderMsg f) = D1 ('MetaData "GenderMsg" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6VfB3GnT9m1A7cm1PjPj6A" 'False) (((C1 ('MetaCons "GenderMsgMale" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "GenderMsgFemale" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgNb" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GenderMsgGender0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GenderMsgGender2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender3" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "GenderMsgGender4" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "GenderMsgGender5" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender6" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GenderMsgGender7" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgGender8" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GenderMsgGender9" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GenderMsgUnspecified" 'PrefixI 'False) (U1 :: Type -> Type)))))

data AddressMsg f Source #

Constructors

AddressMsg 

Fields

Instances

Instances details
Generic (AddressMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep (AddressMsg f) :: Type -> Type #

Methods

from :: AddressMsg f -> Rep (AddressMsg f) x #

to :: Rep (AddressMsg f) x -> AddressMsg f #

type Rep (AddressMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep (AddressMsg f) = D1 ('MetaData "AddressMsg" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6VfB3GnT9m1A7cm1PjPj6A" 'False) (C1 ('MetaCons "AddressMsg" 'PrefixI 'True) (S1 ('MetaSel ('Just "addressMsgPostcode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text)) :*: S1 ('MetaSel ('Just "addressMsgCountry") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text))))

data PersonMsg f Source #

Constructors

PersonMsg 

Fields

Instances

Instances details
Generic (PersonMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

Associated Types

type Rep (PersonMsg f) :: Type -> Type #

Methods

from :: PersonMsg f -> Rep (PersonMsg f) x #

to :: Rep (PersonMsg f) x -> PersonMsg f #

type Rep (PersonMsg f) Source # 
Instance details

Defined in Mu.Schema.Examples

type Rep (PersonMsg f) = D1 ('MetaData "PersonMsg" "Mu.Schema.Examples" "mu-schema-0.3.1.2-6VfB3GnT9m1A7cm1PjPj6A" 'False) (C1 ('MetaCons "PersonMsg" 'PrefixI 'True) ((S1 ('MetaSel ('Just "personMsgFirstName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text)) :*: (S1 ('MetaSel ('Just "personMsgLastName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Text)) :*: S1 ('MetaSel ('Just "personMsgAge") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Maybe Int))))) :*: ((S1 ('MetaSel ('Just "personMsgGender") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (GenderMsg f))) :*: S1 ('MetaSel ('Just "personMsgAddress") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (AddressMsg f)))) :*: (S1 ('MetaSel ('Just "personMsgLucky_numbers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f [Int])) :*: S1 ('MetaSel ('Just "personMsgThings") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Map Text Int)))))))

type ExampleSchema2 = '['DEnum "gender" '['ChoiceDef "Male", 'ChoiceDef "Female", 'ChoiceDef "NonBinary"], 'DRecord "address" '['FieldDef "postcode" ('TPrimitive Text), 'FieldDef "country" ('TPrimitive Text)], 'DRecord "person" '['FieldDef "firstName" ('TPrimitive Text), 'FieldDef "lastName" ('TPrimitive Text), 'FieldDef "age" ('TOption ('TPrimitive Int)), 'FieldDef "gender" ('TOption ('TSchematic "gender")), 'FieldDef "address" ('TSchematic "address")]] Source #

type ExampleRegistry = '[2 :-> ExampleSchema2, 1 :-> ExampleSchema] Source #

\ No newline at end of file diff --git a/wip/haddock/mu-schema/mu-schema.haddock b/wip/haddock/mu-schema/mu-schema.haddock index bc7c420..9eb147c 100644 Binary files a/wip/haddock/mu-schema/mu-schema.haddock and b/wip/haddock/mu-schema/mu-schema.haddock differ diff --git a/wip/haddock/mu-schema/src/Mu.Schema.Examples.html b/wip/haddock/mu-schema/src/Mu.Schema.Examples.html index 7bf0f47..ad02adf 100644 --- a/wip/haddock/mu-schema/src/Mu.Schema.Examples.html +++ b/wip/haddock/mu-schema/src/Mu.Schema.Examples.html @@ -1,4 +1,4 @@ -
{-# language DataKinds             #-}
+
{-# language DataKinds             #-}
 {-# language DeriveAnyClass        #-}
 {-# language DeriveGeneric         #-}
 {-# language DerivingVia           #-}
diff --git a/wip/haddock/mu-schema/src/Mu.Schema.Interpretation.Schemaless.html b/wip/haddock/mu-schema/src/Mu.Schema.Interpretation.Schemaless.html
index d4b03e7..5a45644 100644
--- a/wip/haddock/mu-schema/src/Mu.Schema.Interpretation.Schemaless.html
+++ b/wip/haddock/mu-schema/src/Mu.Schema.Interpretation.Schemaless.html
@@ -1,4 +1,4 @@
-
{-# language AllowAmbiguousTypes   #-}
+
{-# language AllowAmbiguousTypes   #-}
 {-# language DataKinds             #-}
 {-# language FlexibleContexts      #-}
 {-# language FlexibleInstances     #-}
diff --git a/wip/haddock/mu-servant-server/mu-servant-server.haddock b/wip/haddock/mu-servant-server/mu-servant-server.haddock
index 4cf98df..160b4e3 100644
Binary files a/wip/haddock/mu-servant-server/mu-servant-server.haddock and b/wip/haddock/mu-servant-server/mu-servant-server.haddock differ
diff --git a/wip/haddock/mu-tracing/mu-tracing.haddock b/wip/haddock/mu-tracing/mu-tracing.haddock
index 7cbca34..2e07da1 100644
Binary files a/wip/haddock/mu-tracing/mu-tracing.haddock and b/wip/haddock/mu-tracing/mu-tracing.haddock differ