diff options
| -rw-r--r-- | CHANGELOG.md | 2 | ||||
| -rw-r--r-- | graphql-spice.cabal | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Class.hs | 47 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ClassSpec.hs | 20 |
4 files changed, 71 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 8c2ee0d..fb189ba 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,8 @@ and this project adheres to ### Added - `ToGraphQL` and `FromGraphQL` instances for `Word` types, `Float`, `Double`, and `Scientific`. +- `ToGraphQL` and `FromGraphQL` instances for `Day`, `DiffTime`, + `NominalDiffTime`, and `UTCTime`. - `Resolver`: Export `ServerException`. - `Resolver.defaultResolver`: Throw `FieldNotResolvedException` if the requested field is not in the parent object. diff --git a/graphql-spice.cabal b/graphql-spice.cabal index eb8a16e..2ca4923 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -42,6 +42,7 @@ library megaparsec >= 9.0 && < 10, scientific ^>= 0.3.7, text >= 1.2 && < 3, + time >= 1.11.1, transformers ^>= 0.5.6, vector ^>= 0.12.3, unordered-containers ^>= 0.2.16 @@ -67,5 +68,6 @@ test-suite graphql-test hspec >= 2.9.1 && < 3, scientific, text, + time, unordered-containers default-language: Haskell2010 diff --git a/src/Language/GraphQL/Class.hs b/src/Language/GraphQL/Class.hs index cce1bae..49bae57 100644 --- a/src/Language/GraphQL/Class.hs +++ b/src/Language/GraphQL/Class.hs @@ -20,6 +20,17 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector import qualified Language.GraphQL.Type as Type import Data.Scientific (Scientific, toRealFloat) +import qualified Data.Text as Text +import Data.Time + ( Day + , DiffTime + , NominalDiffTime + , UTCTime(..) + , showGregorian + , secondsToNominalDiffTime + , secondsToDiffTime + ) +import Data.Time.Format.ISO8601 (formatParseM, iso8601Format, iso8601Show) fromGraphQLToIntegral :: Integral a => Type.Value -> Maybe a fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value @@ -108,6 +119,22 @@ instance ToGraphQL Scientific where toGraphQL = Type.Float . toRealFloat +instance ToGraphQL Day + where + toGraphQL = Type.String . Text.pack . showGregorian + +instance ToGraphQL DiffTime + where + toGraphQL = Type.Int . truncate . (realToFrac :: DiffTime -> Double) + +instance ToGraphQL NominalDiffTime + where + toGraphQL = Type.Int . truncate . (realToFrac :: NominalDiffTime -> Double) + +instance ToGraphQL UTCTime + where + toGraphQL = Type.String . Text.pack . iso8601Show + -- | Instances of this typeclass can be used to convert GraphQL internal -- representation to user-defined type. class FromGraphQL a @@ -194,3 +221,23 @@ instance FromGraphQL Scientific where fromGraphQL (Type.Float value) = Just $ realToFrac value fromGraphQL _ = Nothing + +instance FromGraphQL Day + where + fromGraphQL (Type.String value') = formatParseM iso8601Format $ Text.unpack value' + fromGraphQL _ = Nothing + +instance FromGraphQL DiffTime + where + fromGraphQL (Type.Int value') = Just $ secondsToDiffTime $ fromIntegral value' + fromGraphQL _ = Nothing + +instance FromGraphQL NominalDiffTime + where + fromGraphQL (Type.Int value') = Just $ secondsToNominalDiffTime $ fromIntegral value' + fromGraphQL _ = Nothing + +instance FromGraphQL UTCTime + where + fromGraphQL (Type.String value') = formatParseM iso8601Format $ Text.unpack value' + fromGraphQL _ = Nothing diff --git a/tests/Language/GraphQL/ClassSpec.hs b/tests/Language/GraphQL/ClassSpec.hs index 087abd0..a5ed41f 100644 --- a/tests/Language/GraphQL/ClassSpec.hs +++ b/tests/Language/GraphQL/ClassSpec.hs @@ -8,6 +8,8 @@ module Language.GraphQL.ClassSpec ) where import Data.Text (Text) +import Data.Time (UTCTime(..)) +import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) import qualified Language.GraphQL.Type as Type import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..)) import Test.Hspec (Spec, describe, it, shouldBe) @@ -30,6 +32,15 @@ spec = do it "converts singleton lists" $ toGraphQL [True] `shouldBe` Type.List [Type.Boolean True] + it "converts UTCTime" $ + let given = UTCTime + { utctDay = fromOrdinalDate 2023 5 + , utctDayTime = 90 + } + actual = toGraphQL given + expected = Type.String "2023-01-05T00:01:30Z" + in actual `shouldBe` expected + describe "FromGraphQL" $ do it "converts integers" $ fromGraphQL (Type.Int 5) `shouldBe` Just (5 :: Int) @@ -45,3 +56,12 @@ spec = do it "converts singleton lists" $ fromGraphQL (Type.List [Type.Boolean True]) `shouldBe` Just [True] + + it "converts UTCTime" $ + let given = Type.String "2023-01-05T00:01:30Z" + expected = Just $ UTCTime + { utctDay = fromOrdinalDate 2023 5 + , utctDayTime = 90 + } + actual = fromGraphQL given + in actual `shouldBe` expected |