graphql-api 0.1.1 → 0.1.2

raw patch · 11 files changed

+91/−88 lines, 11 filesnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• graphql-api.cabal +1/−1
• src/GraphQL/Internal/Name.hs +3/−29
• src/GraphQL/Internal/Output.hs +3/−3
• src/GraphQL/Internal/Schema.hs +6/−8
• src/GraphQL/Internal/Syntax/AST.hs +35/−0
• tests/ASTTests.hs +13/−13
• tests/Doctests.hs +1/−1
• tests/ResolverTests.hs +2/−3
• tests/SchemaTests.hs +12/−14
• tests/ValidationTests.hs +3/−3
• tests/ValueTests.hs +12/−13

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           graphql-api-version:        0.1.1+version:        0.1.2 synopsis:       Sketch of GraphQL stuff description:    Please see README.md category:       Web

@@ -17,43 +17,17 @@  import Protolude -import qualified Data.Attoparsec.Text as A import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import GraphQL.Internal.Syntax.AST   ( Name(..)-  , nameParser+  , NameError(..)+  , unsafeMakeName+  , makeName   ) --- | An invalid name.-newtype NameError = NameError Text deriving (Eq, Show)---- | Create a 'Name'.------ Names must match the regex @[_A-Za-z][_0-9A-Za-z]*@. If the given text does--- not match, return Nothing.------ >>> makeName "foo"--- Right (Name {unName = "foo"})--- >>> makeName "9-bar"--- Left (NameError "9-bar")-makeName :: Text -> Either NameError Name-makeName name = first (const (NameError name)) (A.parseOnly nameParser name)- -- | Convert a type-level 'Symbol' into a GraphQL 'Name'. nameFromSymbol :: forall (n :: Symbol). KnownSymbol n => Either NameError Name nameFromSymbol = makeName (toS (symbolVal @n Proxy))---- | Create a 'Name', panicking if the given text is invalid.------ Prefer 'makeName' to this in all cases.------ >>> unsafeMakeName "foo"--- Name {unName = "foo"}-unsafeMakeName :: HasCallStack => Text -> Name-unsafeMakeName name =-  case makeName name of-    Left e -> panic (show e)-    Right n -> n  -- | Types that implement this have values with a single canonical name in a -- GraphQL schema.

@@ -21,7 +21,7 @@   , pattern ValueNull   , NameError(..)   )-import GraphQL.Internal.Name (unsafeMakeName)+import GraphQL.Internal.Name (Name) import GraphQL.Value.ToValue (ToValue(..))  -- | GraphQL response.@@ -61,9 +61,9 @@ -- | Construct an object from a list of names and values. -- -- Panic if there are duplicate names.-unsafeMakeObject :: HasCallStack => [(Text, Value)] -> Value+unsafeMakeObject :: HasCallStack => [(Name, Value)] -> Value unsafeMakeObject fields =-  case objectFromList (map (first unsafeMakeName) fields) of+  case objectFromList fields of     Nothing -> panic $ "Object has duplicate keys: " <> show fields     Just object -> ValueObject object 

@@ -44,7 +44,7 @@  import qualified Data.Map as Map import GraphQL.Value (Value)-import GraphQL.Internal.Name (HasName(..), Name, unsafeMakeName)+import GraphQL.Internal.Name (HasName(..), Name)  -- | An entire GraphQL schema. --@@ -215,13 +215,11 @@   | GID deriving (Eq, Ord, Show)  instance HasName Builtin where-  getName = unsafeMakeName . getBuiltinName-    where-      getBuiltinName GInt = "Int"-      getBuiltinName GBool = "Boolean"-      getBuiltinName GString = "String"-      getBuiltinName GFloat = "Float"-      getBuiltinName GID = "ID"+  getName GInt = "Int"+  getName GBool = "Boolean"+  getName GString = "String"+  getName GFloat = "Float"+  getName GID = "ID"  data EnumTypeDefinition = EnumTypeDefinition Name [EnumValueDefinition]                           deriving (Eq, Ord, Show)

@@ -6,6 +6,9 @@ module GraphQL.Internal.Syntax.AST   ( Name(unName)   , nameParser+  , NameError(..)+  , unsafeMakeName+  , makeName   , QueryDocument(..)   , SchemaDocument(..)   , Definition(..)@@ -54,6 +57,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Attoparsec.Text as A import Data.Char (isDigit)+import Data.String (IsString(..)) import Test.QuickCheck (Arbitrary(..), elements, listOf, oneof)  import GraphQL.Internal.Arbitrary (arbitraryText)@@ -65,6 +69,37 @@ -- -- https://facebook.github.io/graphql/#sec-Names newtype Name = Name { unName :: Text } deriving (Eq, Ord, Show)++-- | Create a 'Name', panicking if the given text is invalid.+--+-- Prefer 'makeName' to this in all cases.+--+-- >>> unsafeMakeName "foo"+-- Name {unName = "foo"}+unsafeMakeName :: HasCallStack => Text -> Name+unsafeMakeName name =+  case makeName name of+    Left e -> panic (show e)+    Right n -> n++-- | Create a 'Name'.+--+-- Names must match the regex @[_A-Za-z][_0-9A-Za-z]*@. If the given text does+-- not match, return Nothing.+--+-- >>> makeName "foo"+-- Right (Name {unName = "foo"})+-- >>> makeName "9-bar"+-- Left (NameError "9-bar")+makeName :: Text -> Either NameError Name+makeName name = first (const (NameError name)) (A.parseOnly nameParser name)++-- | An invalid name.+newtype NameError = NameError Text deriving (Eq, Show)+++instance IsString Name where+  fromString = unsafeMakeName . toS  instance Aeson.ToJSON Name where   toJSON = Aeson.toJSON . unName

@@ -13,7 +13,7 @@ import Test.Tasty.Hspec (testSpec, describe, it, shouldBe)  import GraphQL.Value (String(..))-import GraphQL.Internal.Name (Name, unsafeMakeName)+import GraphQL.Internal.Name (Name) import qualified GraphQL.Internal.Syntax.AST as AST import qualified GraphQL.Internal.Syntax.Parser as Parser import qualified GraphQL.Internal.Syntax.Encoder as Encoder@@ -22,10 +22,10 @@ kitchenSink = "query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:\"value\"})}\n"  dog :: Name-dog = unsafeMakeName "dog"+dog = "dog"  someName :: Name-someName = unsafeMakeName "name"+someName = "name"  tests :: IO TestTree tests = testSpec "AST" $ do@@ -62,9 +62,9 @@       it "parses ununusual objects" $ do         let input = AST.ValueObject                     (AST.ObjectValue-                     [ AST.ObjectField (unsafeMakeName "s")+                     [ AST.ObjectField "s"                        (AST.ValueString (AST.StringValue "\224\225v^6{FPDk\DC3\a")),-                       AST.ObjectField (unsafeMakeName "Hsr") (AST.ValueInt 0)+                       AST.ObjectField "Hsr" (AST.ValueInt 0)                      ])         let output = Encoder.value input         parseOnly Parser.value output `shouldBe` Right input@@ -121,11 +121,11 @@                          ])                      , AST.DefinitionOperation                        (AST.Query-                        (AST.Node (unsafeMakeName "getName") [] []+                        (AST.Node "getName" [] []                          [ AST.SelectionField                            (AST.Field Nothing dog [] []                             [ AST.SelectionField-                              (AST.Field Nothing (unsafeMakeName "owner") [] []+                              (AST.Field Nothing "owner" [] []                                [ AST.SelectionField (AST.Field Nothing someName [] [] [])                                ])                             ])@@ -145,18 +145,18 @@       let expected = AST.QueryDocument                      [ AST.DefinitionOperation                          (AST.Query-                           (AST.Node (unsafeMakeName "houseTrainedQuery")+                           (AST.Node "houseTrainedQuery"                             [ AST.VariableDefinition-                                (AST.Variable (unsafeMakeName "atOtherHomes"))-                                (AST.TypeNamed (AST.NamedType (unsafeMakeName "Boolean")))+                                (AST.Variable "atOtherHomes")+                                (AST.TypeNamed (AST.NamedType "Boolean"))                                 (Just (AST.ValueBoolean True))                             ] []                             [ AST.SelectionField                                 (AST.Field Nothing dog [] []                                  [ AST.SelectionField-                                     (AST.Field Nothing (unsafeMakeName "isHousetrained")-                                      [ AST.Argument (unsafeMakeName "atOtherHomes")-                                          (AST.ValueVariable (AST.Variable (unsafeMakeName "atOtherHomes")))+                                     (AST.Field Nothing "isHousetrained"+                                      [ AST.Argument "atOtherHomes"+                                          (AST.ValueVariable (AST.Variable "atOtherHomes"))                                       ] [] [])                                  ])                             ]))

@@ -17,5 +17,5 @@                  ]     -- library code and examples     files = [ "src/"-            , "examples/"+            , "tests/Examples/"             ]

@@ -24,7 +24,6 @@   , ResolverError(..)   , (:<>)(..)   )-import GraphQL.Internal.Name (unsafeMakeName) import GraphQL.Internal.Output (singleError)  -- Test a custom error monad@@ -46,7 +45,7 @@       encode object `shouldBe` "{\"t\":12}"     it "complains about missing field" $ do       Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ not_a_field }")-      errs `shouldBe` singleError (FieldNotFoundError (unsafeMakeName "not_a_field"))+      errs `shouldBe` singleError (FieldNotFoundError "not_a_field")     it "complains about missing argument" $ do       Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ t }")-      errs `shouldBe` singleError (ValueMissing (unsafeMakeName "x"))+      errs `shouldBe` singleError (ValueMissing "x")

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-} module SchemaTests (tests) where @@ -18,7 +17,6 @@   , getFieldDefinition   , getInterfaceDefinition   )-import GraphQL.Internal.Name (unsafeMakeName) import GraphQL.Internal.Schema   ( EnumTypeDefinition(..)   , EnumValueDefinition(..)@@ -41,33 +39,33 @@ tests = testSpec "Type" $ do   describe "Field" $     it "encodes correctly" $ do-    getFieldDefinition @(Field "hello" Int) `shouldBe` Right (FieldDefinition (unsafeMakeName "hello") [] (TypeNonNull (NonNullTypeNamed (BuiltinType GInt))))+    getFieldDefinition @(Field "hello" Int) `shouldBe` Right (FieldDefinition "hello" [] (TypeNonNull (NonNullTypeNamed (BuiltinType GInt))))   describe "Interface" $     it "encodes correctly" $ do     getInterfaceDefinition @Sentient `shouldBe`       Right (InterfaceTypeDefinition-        (unsafeMakeName "Sentient")-        (NonEmptyList [FieldDefinition (unsafeMakeName "name") [] (TypeNonNull (NonNullTypeNamed (BuiltinType GString)))]))+        "Sentient"+        (NonEmptyList [FieldDefinition "name" [] (TypeNonNull (NonNullTypeNamed (BuiltinType GString)))]))   describe "full example" $     it "encodes correctly" $ do     getDefinition @Human `shouldBe`-      Right (ObjectTypeDefinition (unsafeMakeName "Human")-        [ InterfaceTypeDefinition (unsafeMakeName "Sentient") (-            NonEmptyList [FieldDefinition (unsafeMakeName "name") [] (TypeNonNull (NonNullTypeNamed (BuiltinType GString)))])+      Right (ObjectTypeDefinition "Human"+        [ InterfaceTypeDefinition "Sentient" (+            NonEmptyList [FieldDefinition "name" [] (TypeNonNull (NonNullTypeNamed (BuiltinType GString)))])         ]-        (NonEmptyList [FieldDefinition (unsafeMakeName "name") [] (TypeNonNull (NonNullTypeNamed (BuiltinType GString)))]))+        (NonEmptyList [FieldDefinition "name" [] (TypeNonNull (NonNullTypeNamed (BuiltinType GString)))]))   describe "output Enum" $     it "encodes correctly" $ do     getAnnotatedType @(Enum "DogCommand" DogCommand) `shouldBe`-       Right (TypeNonNull (NonNullTypeNamed (DefinedType (TypeDefinitionEnum (EnumTypeDefinition (unsafeMakeName "DogCommand")-         [ EnumValueDefinition (unsafeMakeName "Sit")-         , EnumValueDefinition (unsafeMakeName "Down")-         , EnumValueDefinition (unsafeMakeName "Heel")+       Right (TypeNonNull (NonNullTypeNamed (DefinedType (TypeDefinitionEnum (EnumTypeDefinition "DogCommand"+         [ EnumValueDefinition "Sit"+         , EnumValueDefinition "Down"+         , EnumValueDefinition "Heel"          ])))))   describe "Union type" $     it "encodes correctly" $ do     getAnnotatedType @CatOrDog `shouldBe`-      TypeNamed . DefinedType . TypeDefinitionUnion . UnionTypeDefinition (unsafeMakeName "CatOrDog")+      TypeNamed . DefinedType . TypeDefinitionUnion . UnionTypeDefinition "CatOrDog"         . NonEmptyList <$> sequence [ getDefinition @Cat                                     , getDefinition @Dog                                     ]

@@ -10,7 +10,7 @@ import Test.Tasty (TestTree) import Test.Tasty.Hspec (testSpec, describe, it, shouldBe) -import GraphQL.Internal.Name (Name, unsafeMakeName)+import GraphQL.Internal.Name (Name) import qualified GraphQL.Internal.Syntax.AST as AST import GraphQL.Internal.Schema (Schema) import GraphQL.Internal.Validation@@ -20,10 +20,10 @@   )  me :: Name-me = unsafeMakeName "me"+me = "me"  someName :: Name-someName = unsafeMakeName "name"+someName = "name"  -- | Schema used for these tests. Since none of them do type-level stuff, we -- don't need to define it.

@@ -9,7 +9,6 @@  import qualified GraphQL.Internal.Syntax.AST as AST import GraphQL.Internal.Arbitrary (arbitraryText, arbitraryNonEmpty)-import GraphQL.Internal.Name (unsafeMakeName) import GraphQL.Value   ( Object   , ObjectField'(..)@@ -28,19 +27,19 @@     it "returns empty on empty list" $ do       unionObjects [] `shouldBe` (objectFromList [] :: Maybe Object)     it "merges objects" $ do-      let (Just foo) = objectFromList [ (unsafeMakeName "foo", toValue @Int32 1)-                                      , (unsafeMakeName "bar",toValue @Int32 2)]-      let (Just bar) = objectFromList [ (unsafeMakeName "bar", toValue @Text "cow")-                                      , (unsafeMakeName "baz",toValue @Int32 3)]+      let (Just foo) = objectFromList [ ("foo", toValue @Int32 1)+                                      , ("bar",toValue @Int32 2)]+      let (Just bar) = objectFromList [ ("bar", toValue @Text "cow")+                                      , ("baz",toValue @Int32 3)]       let observed = unionObjects [foo, bar]       observed `shouldBe` Nothing     it "merges objects with unique keys" $ do-      let (Just foo) = objectFromList [(unsafeMakeName "foo", toValue @Int32 1)]-      let (Just bar) = objectFromList [ (unsafeMakeName "bar", toValue @Text "cow")-                                      , (unsafeMakeName "baz",toValue @Int32 3)]-      let (Just expected) = objectFromList [ (unsafeMakeName "foo", toValue @Int32 1)-                                           , (unsafeMakeName "bar", toValue @Text "cow")-                                           , (unsafeMakeName "baz", toValue @Int32 3)+      let (Just foo) = objectFromList [("foo", toValue @Int32 1)]+      let (Just bar) = objectFromList [ ("bar", toValue @Text "cow")+                                      , ("baz",toValue @Int32 3)]+      let (Just expected) = objectFromList [ ("foo", toValue @Int32 1)+                                           , ("bar", toValue @Text "cow")+                                           , ("baz", toValue @Int32 3)                                            ]       let (Just observed) = unionObjects [foo, bar]       observed `shouldBe` expected@@ -57,8 +56,8 @@     prop "Non-empty lists" $ forAll (arbitraryNonEmpty @Int32) prop_roundtripValue   describe "AST" $ do     it "Objects converted from AST have unique fields" $ do-      let input = AST.ObjectValue [ AST.ObjectField (unsafeMakeName "foo") (AST.ValueString (AST.StringValue "bar"))-                                  , AST.ObjectField (unsafeMakeName "foo") (AST.ValueString (AST.StringValue "qux"))+      let input = AST.ObjectValue [ AST.ObjectField "foo" (AST.ValueString (AST.StringValue "bar"))+                                  , AST.ObjectField "foo" (AST.ValueString (AST.StringValue "qux"))                                   ]       astToVariableValue (AST.ValueObject input) `shouldBe` Nothing