graphql-api 0.1.2 → 0.2.0

raw patch · 15 files changed

+96/−44 lines, 15 filesdep +ghc-primdep ~protoludePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: protolude

API changes (from Hackage documentation)

Files

• graphql-api.cabal +9/−6
• src/GraphQL/API.hs +1/−0
• src/GraphQL/API/Enum.hs +22/−21
• src/GraphQL/Internal/Execution.hs +1/−1
• src/GraphQL/Internal/Schema.hs +1/−1
• src/GraphQL/Internal/Syntax/AST.hs +1/−1
• src/GraphQL/Internal/Syntax/Encoder.hs +1/−1
• src/GraphQL/Internal/Syntax/Parser.hs +1/−1
• src/GraphQL/Internal/Validation.hs +2/−1
• src/GraphQL/Resolver.hs +9/−7
• src/GraphQL/Value/FromValue.hs +2/−2
• tests/EndToEndTests.hs +1/−2
• tests/EnumTests.hs +13/−0
• tests/ResolverTests.hs +31/−0
• tests/Spec.hs +1/−0

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.15.0.+-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack  name:           graphql-api-version:        0.1.2+version:        0.2.0 synopsis:       Sketch of GraphQL stuff description:    Please see README.md category:       Web@@ -26,12 +26,13 @@   ghc-options: -Wall -fno-warn-redundant-constraints   build-depends:       base >= 4.9 && < 5-    , protolude+    , protolude >= 0.2     , exceptions     , transformers     , attoparsec     , aeson     , containers+    , ghc-prim     , scientific     , QuickCheck     , text@@ -65,7 +66,7 @@   ghc-options: -Wall -fno-warn-redundant-constraints -threaded   build-depends:       base >= 4.9 && < 5-    , protolude+    , protolude >= 0.2     , exceptions     , transformers     , attoparsec@@ -73,6 +74,7 @@   other-modules:       ASTTests       EndToEndTests+      EnumTests       Examples.InputObject       Examples.UnionExample       ExampleSchema@@ -93,7 +95,7 @@   ghc-options: -Wall -fno-warn-redundant-constraints   build-depends:       base >= 4.9 && < 5-    , protolude+    , protolude >= 0.2     , exceptions     , transformers     , attoparsec@@ -110,6 +112,7 @@       ASTTests       Doctests       EndToEndTests+      EnumTests       Examples.InputObject       Examples.UnionExample       ExampleSchema@@ -129,7 +132,7 @@   ghc-options: -Wall -fno-warn-redundant-constraints   build-depends:       base >= 4.9 && < 5-    , protolude+    , protolude >= 0.2     , exceptions     , transformers     , attoparsec

@@ -40,6 +40,7 @@ import GraphQL.Internal.Name (NameError, nameFromSymbol) import GraphQL.API.Enum (GraphQLEnum(..)) import GHC.Generics ((:*:)(..))+import GHC.Types (Type)   -- $setup

@@ -17,6 +17,7 @@ import GraphQL.Internal.Output (GraphQLError(..)) import GHC.Generics (D, (:+:)(..)) import GHC.TypeLits (KnownSymbol, TypeError, ErrorMessage(..))+import GHC.Types (Type)  invalidEnumName :: forall t. NameError -> Either Text t invalidEnumName x = Left ("In Enum: " <> formatError x)@@ -42,20 +43,30 @@   genericEnumFromValue name = M1 <$> genericEnumFromValue name   genericEnumToValue (M1 gv) = genericEnumToValue gv -instance forall conName f p b.-  ( KnownSymbol conName-  , GenericEnumValues f-  ) => GenericEnumValues (C1 ('MetaCons conName p b) U1 :+: f) where-  genericEnumValues = let name = nameFromSymbol @conName in name:genericEnumValues @f+instance forall left right.+  ( GenericEnumValues left+  , GenericEnumValues right+  ) => GenericEnumValues (left :+: right) where+  genericEnumValues = genericEnumValues @left <> genericEnumValues @right   genericEnumFromValue vname =+    let left = genericEnumFromValue @left vname+        right = genericEnumFromValue @right vname+    in case (left, right) of+      (x@(Right _), Left _) -> L1 <$> x+      (Left _, x@(Right _)) -> R1 <$> x+      (err@(Left _), Left _) -> L1 <$> err+      _ -> panic "Can't have two successful branches in Haskell"++  genericEnumToValue (L1 gv) = genericEnumToValue gv+  genericEnumToValue (R1 gv) = genericEnumToValue gv++instance forall conName p b. (KnownSymbol conName) => GenericEnumValues (C1 ('MetaCons conName p b) U1) where+  genericEnumValues = let name = nameFromSymbol @conName in [name]+  genericEnumFromValue vname =     case nameFromSymbol @conName of       Right name -> if name == vname-                    then L1 <$> Right (M1 U1)-                    else R1 <$> genericEnumFromValue vname-      Left x -> invalidEnumName x-  genericEnumToValue (L1 _) =-    case nameFromSymbol @conName of-      Right name -> name+                    then Right (M1 U1)+                    else Left ("Not a valid choice for enum: " <> show vname)       -- XXX: This is impossible to catch during validation, because we cannot       -- validate type-level symbols, we can only validate values. We could       -- show that the schema is invalid at the type-level and still decide to@@ -64,16 +75,6 @@       --       -- Further, we don't actually have any schema-level validation, so       -- "should have been caught during validation" is misleading.-      Left err -> panic ("Invalid name: " <> show err <> ". This should have been caught during validation. Please file a bug.")-  genericEnumToValue (R1 gv) = genericEnumToValue gv--instance forall conName p b. (KnownSymbol conName) => GenericEnumValues (C1 ('MetaCons conName p b) U1) where-  genericEnumValues = let name = nameFromSymbol @conName in [name]-  genericEnumFromValue vname =-    case nameFromSymbol @conName of-      Right name -> if name == vname-                    then Right (M1 U1)-                    else Left ("Not a valid choice for enum: " <> show vname)       Left x -> invalidEnumName x   genericEnumToValue (M1 _) =     let Right name = nameFromSymbol @conName

@@ -14,7 +14,7 @@   , substituteVariables   ) where -import Protolude hiding (Type)+import Protolude  import qualified Data.Map as Map import GraphQL.Value

@@ -40,7 +40,7 @@   , lookupType   ) where -import Protolude hiding (Type)+import Protolude  import qualified Data.Map as Map import GraphQL.Value (Value)

@@ -52,7 +52,7 @@   , TypeExtensionDefinition(..)   ) where -import Protolude hiding (Type)+import Protolude  import qualified Data.Aeson as Aeson import qualified Data.Attoparsec.Text as A

@@ -4,7 +4,7 @@   , value   ) where -import Protolude hiding (Type, intercalate)+import Protolude hiding (intercalate)  import qualified Data.Aeson as Aeson import Data.Text (Text, cons, intercalate, pack, snoc)

@@ -5,7 +5,7 @@   , value   ) where -import Protolude hiding (Type, takeWhile)+import Protolude hiding (option, takeWhile)  import Control.Applicative ((<|>), empty, many, optional) import Control.Monad (fail)

@@ -58,11 +58,12 @@   , findDuplicates   ) where -import Protolude+import Protolude hiding ((<>))  import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map+import Data.Semigroup ((<>)) import qualified Data.Set as Set import GraphQL.Internal.Name (HasName(..), Name) import qualified GraphQL.Internal.Syntax.AST as AST

@@ -35,6 +35,7 @@ import qualified Data.Text as Text import qualified Data.List.NonEmpty as NonEmpty import GHC.TypeLits (KnownSymbol, TypeError, ErrorMessage(..), Symbol, symbolVal)+import GHC.Types (Type) import qualified GHC.Exts (Any) import Unsafe.Coerce (unsafeCoerce) @@ -95,7 +96,7 @@   formatError (SubSelectionOnLeaf ss) =     "Tried to get values within leaf field: " <> show ss   formatError MissingSelectionSet =-    "Triet to treat object as if it were leaf field."+    "Tried to treat object as if it were leaf field."  -- | Object field separation operator. --@@ -210,12 +211,13 @@   resolve handler Nothing = (pure . ok . GValue.ValueEnum . API.enumToValue) handler   resolve _ (Just ss) = throwE (SubSelectionOnLeaf ss) --- TODO: This is our handler for `Maybe a`, which is currently used to--- implement nullable types. It's *probably* broken, in that it's discarding--- the selection set. <https://github.com/jml/graphql-api/issues/102>-instance forall m hg. (HasResolver m hg, Functor m, ToValue (Maybe hg)) => HasResolver m (Maybe hg) where-  type Handler m (Maybe hg) = m (Maybe hg)-  resolve handler _ =  map (ok . toValue) handler+instance forall m hg. (HasResolver m hg, Monad m) => HasResolver m (Maybe hg) where+  type Handler m (Maybe hg) = m (Maybe (Handler m hg))+  resolve handler selectionSet = do+    result <- handler+    case result of+      Just x -> resolve @m @hg (x :: Handler m hg) selectionSet+      Nothing -> (pure . ok) GValue.ValueNull  -- TODO: A parametrized `Result` is really not a good way to handle the -- "result" for resolveField, but not sure what to use either. Tom liked the

@@ -25,6 +25,7 @@ import Data.List.NonEmpty (NonEmpty) import GHC.Generics ((:*:)(..)) import GHC.TypeLits (KnownSymbol, TypeError, ErrorMessage(..))+import GHC.Types (Type)  -- * FromValue @@ -81,8 +82,7 @@  -- | Throw an error saying that @value@ does not have the @expected@ type. wrongType :: (MonadError Text m, Show a) => Text -> a -> m b-wrongType expected value = throwError ("Wrong type, should be " <> expected <> show value)-+wrongType expected value = throwError ("Wrong type, should be: `" <> expected <> "` but is: `" <> show value <> "`")  -- We only allow generic record reading for now because I am not sure -- how we should interpret any other generic things (e.g. tuples).

@@ -61,7 +61,7 @@ viewServerDog :: ServerDog -> Handler IO Dog viewServerDog dog@(ServerDog{..}) = pure $   pure name :<>-  pure nickname :<>+  pure (fmap pure nickname) :<>   pure barkVolume :<>   pure . doesKnowCommand dog :<>   pure . isHouseTrained dog :<>@@ -326,4 +326,3 @@                 ]               ]         toJSON (toValue response) `shouldBe` expected-

@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveGeneric #-}+module EnumTests () where++import Protolude hiding (Enum)++import GraphQL.API.Enum (GraphQLEnum)++-- https://github.com/jml/graphql-api/issues/116+-- Generic enum code is broken++data Mode = Directory | NormalFile | ExecutableFile | Symlink deriving (Show, Eq, Generic)++instance GraphQLEnum Mode

@@ -37,6 +37,33 @@ tHandler =   pure $ (pure 10) :<> (\tArg -> pure tArg) :<> (pure . (*2)) ++-- https://github.com/jml/graphql-api/issues/119+-- Maybe X didn't descend into its argument. Now it does.+type Query = Object "Query" '[]+  '[ Argument "id" Text :> Field "test" (Maybe Foo) ]++type Foo = Object "Foo" '[]+  '[ Field "name" Text ]++data ServerFoo = ServerFoo+  { name :: Text+  } deriving (Eq, Show)++lookupFoo :: Text -> IO (Maybe ServerFoo)+lookupFoo _ = pure $ Just (ServerFoo "Mort")++viewFoo :: ServerFoo -> Handler IO Foo+viewFoo ServerFoo { name=name } = pure $ pure $ name++handler :: Handler IO Query+handler = pure $ \fooId -> do+  foo <- lookupFoo fooId+  -- note that fmap maps over the Maybe, so we still need+  -- have to wrap the result in a pure.+  sequence $ fmap (pure . viewFoo) foo++ tests :: IO TestTree tests = testSpec "TypeAPI" $ do   describe "tTest" $ do@@ -49,3 +76,7 @@     it "complains about missing argument" $ do       Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ t }")       errs `shouldBe` singleError (ValueMissing "x")+  describe "issue 119" $ do+    it "Just works" $ do+      Success object <- interpretAnonymousQuery @Query handler "{ test(id: \"10\") { name } }"+      encode object `shouldBe` "{\"test\":{\"name\":\"Mort\"}}"

@@ -13,6 +13,7 @@ import qualified SchemaTests import qualified ValidationTests import qualified ValueTests+import qualified EnumTests ()  -- import examples to ensure they compile import Examples.InputObject ()