From 53ce65d7137a983df43056a3ea33d31054afd5fc Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Thu, 8 Sep 2022 19:53:22 +0200 Subject: [PATCH] Add `ToGraphQL` and `FromGraphQL` typeclasses With instances for basic types. --- CHANGELOG.md | 6 ++ graphql-spice.cabal | 4 +- src/Language/GraphQL/Class.hs | 105 ++++++++++++++++++++++++++++ tests/Language/GraphQL/ClassSpec.hs | 47 +++++++++++++ 4 files changed, 161 insertions(+), 1 deletion(-) create mode 100644 src/Language/GraphQL/Class.hs create mode 100644 tests/Language/GraphQL/ClassSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 8366c2e..e274b42 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,7 +6,13 @@ The format is based on and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [Unreleased] +### Added +- `ToGraphQL` and `FromGraphQL` typeclasses with instances for basic types. + ## [1.0.0.0] - 2022-03-29 ### Added - JSON serialization. - Test helpers. + +[Unreleased]: https://www.caraus.tech/projects/pub-graphql-spice/repository/28/diff?rev=master&rev_to=v1.0.0.0 diff --git a/graphql-spice.cabal b/graphql-spice.cabal index abaf140..f774dcc 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -24,7 +24,8 @@ source-repository head library exposed-modules: - Language.GraphQL.JSON, + Language.GraphQL.Class + Language.GraphQL.JSON Test.Hspec.GraphQL other-modules: hs-source-dirs: src @@ -48,6 +49,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 diff --git a/src/Language/GraphQL/Class.hs b/src/Language/GraphQL/Class.hs new file mode 100644 index 0000000..66a0b2b --- /dev/null +++ b/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 + _ -> 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 diff --git a/tests/Language/GraphQL/ClassSpec.hs b/tests/Language/GraphQL/ClassSpec.hs new file mode 100644 index 0000000..087abd0 --- /dev/null +++ b/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]