Release latest changes in 1.0.1.0

With instances for basic types.

CHANGELOG.md

@@ -6,7 +6,14 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
-## [1.0.0.0] - 2022-03-29
+## [1.0.1.0] - 2023-02-17
+### Added
+- `ToGraphQL` and `FromGraphQL` typeclasses with instances for basic types.
+- `Resolver` module with `argument` and `defaultResolver` helper functions.
+
+## 1.0.0.0 - 2022-03-29
 ### Added
 - JSON serialization.
 - Test helpers.
+
+[1.0.1.0]: https://www.caraus.tech/projects/pub-graphql-spice/repository/28/diff?rev=v1.0.1.0&rev_to=v1.0.0.0

graphql-spice.cabal

@@ -1,7 +1,7 @@
 cabal-version:      2.4
 
 name:               graphql-spice
-version:            1.0.0.0
+version:            1.0.1.0
 synopsis:           GraphQL with batteries
 description:        Various extensions and convenience functions  for the core
                     graphql package.
@@ -10,13 +10,13 @@ homepage:           https://www.caraus.tech/projects/pub-graphql-spice
 bug-reports:        https://www.caraus.tech/projects/pub-graphql-spice/issues
 author:             Eugen Wissner <belka@caraus.de>
 maintainer:         belka@caraus.de
-copyright:          (c) 2021-2022 Eugen Wissner
+copyright:          (c) 2021-2023 Eugen Wissner
 license:            MPL-2.0
 license-files:      LICENSE
 build-type:         Simple
 extra-source-files: CHANGELOG.md
 tested-with:
-  GHC == 8.10.7
+  GHC == 9.2.5
 
 source-repository head
   type: git
@@ -24,7 +24,9 @@ source-repository head
 
 library
     exposed-modules:
-      Language.GraphQL.JSON,
+      Language.GraphQL.Class
+      Language.GraphQL.JSON
+      Language.GraphQL.Resolver
       Test.Hspec.GraphQL
     other-modules:
     hs-source-dirs:   src
@@ -36,10 +38,11 @@ library
       containers ^>= 0.6.2,
       exceptions ^>= 0.10.4,
       hspec-expectations >= 0.8.2 && < 0.9,
-      graphql ^>= 1.0.3.0,
+      graphql >= 1.0,
       megaparsec >= 9.0 && < 10,
       scientific ^>= 0.3.7,
       text >= 1.2 && < 3,
+      transformers ^>= 0.5.6,
       vector ^>= 0.12.3,
       unordered-containers ^>= 0.2.16
     default-language: Haskell2010
@@ -48,6 +51,7 @@ test-suite graphql-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+    Language.GraphQL.ClassSpec
     Language.GraphQL.CoerceSpec
     Language.GraphQL.DirectiveSpec
     Language.GraphQL.FragmentSpec

src/Language/GraphQL/Class.hs

@@ -0,0 +1,105 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | ToGraphQL and FromGraphQL typeclasses used for user-defined type
+-- conversion.
+module Language.GraphQL.Class
+    ( FromGraphQL(..)
+    , ToGraphQL(..)
+    ) where
+
+import Data.Foldable (toList)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Text (Text)
+import qualified Data.Text.Read as Text.Read
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import qualified Language.GraphQL.Type as Type
+
+fromGraphQLToIntegral :: Integral a => Type.Value -> Maybe a
+fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value
+fromGraphQLToIntegral (Type.String value) =
+    case Text.Read.decimal value of
+        Right (converted, "") -> Just converted
+        _conversionError -> Nothing
+fromGraphQLToIntegral _ = Nothing
+
+-- | Instances of this typeclass can be converted to GraphQL internal
+-- representation.
+class ToGraphQL a where
+    toGraphQL :: a -> Type.Value
+
+instance ToGraphQL Text where
+    toGraphQL = Type.String
+
+instance ToGraphQL Int where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Int8 where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Int16 where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Int32 where
+    toGraphQL = Type.Int
+
+instance ToGraphQL Int64 where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL a => ToGraphQL [a] where
+    toGraphQL = Type.List . fmap toGraphQL
+
+instance ToGraphQL a => ToGraphQL (Vector a) where
+    toGraphQL = Type.List . toList . fmap toGraphQL
+
+instance ToGraphQL a => ToGraphQL (Maybe a) where
+    toGraphQL (Just justValue) = toGraphQL justValue
+    toGraphQL Nothing = Type.Null
+
+instance ToGraphQL Bool where
+    toGraphQL = Type.Boolean
+
+-- | Instances of this typeclass can be used to convert GraphQL internal
+-- representation to user-defined type.
+class FromGraphQL a where
+    fromGraphQL :: Type.Value -> Maybe a
+
+instance FromGraphQL Text where
+    fromGraphQL (Type.String value) = Just value
+    fromGraphQL _ = Nothing
+
+instance FromGraphQL Int where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int8 where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int16 where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int32 where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int64 where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL a => FromGraphQL [a] where
+    fromGraphQL (Type.List value) = traverse fromGraphQL value
+    fromGraphQL _ = Nothing
+
+instance FromGraphQL a => FromGraphQL (Vector a) where
+    fromGraphQL (Type.List value) = Vector.fromList
+        <$> traverse fromGraphQL value
+    fromGraphQL _ = Nothing
+
+instance FromGraphQL a => FromGraphQL (Maybe a) where
+    fromGraphQL Type.Null = Just Nothing
+    fromGraphQL value = Just <$> fromGraphQL value
+
+instance FromGraphQL Bool where
+    fromGraphQL (Type.Boolean value) = Just value
+    fromGraphQL _ = Nothing

src/Language/GraphQL/Resolver.hs

@@ -0,0 +1,61 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Helper functions and exceptions to write resolvers.
+module Language.GraphQL.Resolver
+    ( argument
+    , defaultResolver
+    ) where
+
+import Control.Monad.Catch (Exception(..), MonadCatch(..), MonadThrow(..))
+import Control.Monad.Trans.Reader (ReaderT, asks)
+import Data.HashMap.Strict ((!))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Typeable (cast)
+import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.Error
+import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Class (FromGraphQL(..))
+
+-- | Exceptions thrown by the functions in this module.
+data ServerException
+    = FieldNotResolvedException !Text
+    | ErroneousArgumentTypeException !Text
+
+instance Show ServerException where
+    show (FieldNotResolvedException fieldName) =
+        Text.unpack $ Text.unwords ["Field", fieldName, "not resolved."]
+    show (ErroneousArgumentTypeException argumentName) =
+        Text.unpack $ Text.unwords
+            [ "Unable to convert the argument"
+            , argumentName
+            , "to a user-defined type."
+            ]
+
+instance Exception ServerException where
+    toException = toException . ResolverException
+    fromException x = do
+        ResolverException a <- fromException x
+        cast a
+
+-- | Default resolver expects that the field value is returned by the parent
+-- object. If the parent is not an object or it doesn't contain the requested
+-- field name, an error is thrown.
+defaultResolver :: MonadCatch m => Name -> Type.Resolve m
+defaultResolver fieldName = do
+    values' <- asks Type.values
+    case values' of
+        Type.Object objectValue -> pure $ objectValue ! fieldName
+        _nonObject -> throwM $ FieldNotResolvedException fieldName
+
+-- | Takes an argument name, validates that the argument exists, and optionally
+-- converts it to a user-defined type.
+argument :: (MonadCatch m, FromGraphQL a) => Name -> ReaderT Type.Context m a
+argument argumentName =
+    Type.argument argumentName >>= maybe throwError pure . fromGraphQL
+  where
+    throwError = throwM $ ErroneousArgumentTypeException argumentName

tests/Language/GraphQL/ClassSpec.hs

@@ -0,0 +1,47 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.ClassSpec
+    ( spec
+    ) where
+
+import Data.Text (Text)
+import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..))
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+spec :: Spec
+spec = do
+    describe "ToGraphQL" $ do
+        it "converts integers" $
+            toGraphQL (5 :: Int) `shouldBe` Type.Int 5
+
+        it "converts text" $
+            toGraphQL ("String" :: Text) `shouldBe` Type.String "String"
+
+        it "converts booleans" $
+            toGraphQL True `shouldBe` Type.Boolean True
+
+        it "converts Nothing to Null" $
+            toGraphQL (Nothing :: Maybe Int) `shouldBe` Type.Null
+
+        it "converts singleton lists" $
+            toGraphQL [True] `shouldBe` Type.List [Type.Boolean True]
+
+    describe "FromGraphQL" $ do
+        it "converts integers" $
+            fromGraphQL (Type.Int 5) `shouldBe` Just (5 :: Int)
+
+        it "converts text" $
+            fromGraphQL (Type.String "String") `shouldBe` Just ("String" :: Text)
+
+        it "converts booleans" $
+            fromGraphQL (Type.Boolean True) `shouldBe` Just True
+
+        it "converts Null to Nothing" $
+            fromGraphQL Type.Null `shouldBe` Just (Nothing :: Maybe Int)
+
+        it "converts singleton lists" $
+            fromGraphQL (Type.List [Type.Boolean True]) `shouldBe` Just [True]