Add instances for UTCTime

This commit is contained in:
Eugen Wissner 2023-06-26 16:50:14 +02:00
parent f90feb488d
commit 36f45861de
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 71 additions and 0 deletions

View File

@ -10,6 +10,8 @@ and this project adheres to
### Added ### Added
- `ToGraphQL` and `FromGraphQL` instances for `Word` types, `Float`, `Double`, - `ToGraphQL` and `FromGraphQL` instances for `Word` types, `Float`, `Double`,
and `Scientific`. and `Scientific`.
- `ToGraphQL` and `FromGraphQL` instances for `Day`, `DiffTime`,
`NominalDiffTime`, and `UTCTime`.
- `Resolver`: Export `ServerException`. - `Resolver`: Export `ServerException`.
- `Resolver.defaultResolver`: Throw `FieldNotResolvedException` if the requested - `Resolver.defaultResolver`: Throw `FieldNotResolvedException` if the requested
field is not in the parent object. field is not in the parent object.

View File

@ -42,6 +42,7 @@ library
megaparsec >= 9.0 && < 10, megaparsec >= 9.0 && < 10,
scientific ^>= 0.3.7, scientific ^>= 0.3.7,
text >= 1.2 && < 3, text >= 1.2 && < 3,
time >= 1.11.1,
transformers ^>= 0.5.6, transformers ^>= 0.5.6,
vector ^>= 0.12.3, vector ^>= 0.12.3,
unordered-containers ^>= 0.2.16 unordered-containers ^>= 0.2.16
@ -67,5 +68,6 @@ test-suite graphql-test
hspec >= 2.9.1 && < 3, hspec >= 2.9.1 && < 3,
scientific, scientific,
text, text,
time,
unordered-containers unordered-containers
default-language: Haskell2010 default-language: Haskell2010

View File

@ -20,6 +20,17 @@ import Data.Vector (Vector)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type as Type
import Data.Scientific (Scientific, toRealFloat) 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 :: Integral a => Type.Value -> Maybe a
fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value
@ -108,6 +119,22 @@ instance ToGraphQL Scientific
where where
toGraphQL = Type.Float . toRealFloat 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 -- | Instances of this typeclass can be used to convert GraphQL internal
-- representation to user-defined type. -- representation to user-defined type.
class FromGraphQL a class FromGraphQL a
@ -194,3 +221,23 @@ instance FromGraphQL Scientific
where where
fromGraphQL (Type.Float value) = Just $ realToFrac value fromGraphQL (Type.Float value) = Just $ realToFrac value
fromGraphQL _ = Nothing 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

View File

@ -8,6 +8,8 @@ module Language.GraphQL.ClassSpec
) where ) where
import Data.Text (Text) import Data.Text (Text)
import Data.Time (UTCTime(..))
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
import qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..)) import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..))
import Test.Hspec (Spec, describe, it, shouldBe) import Test.Hspec (Spec, describe, it, shouldBe)
@ -30,6 +32,15 @@ spec = do
it "converts singleton lists" $ it "converts singleton lists" $
toGraphQL [True] `shouldBe` Type.List [Type.Boolean True] 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 describe "FromGraphQL" $ do
it "converts integers" $ it "converts integers" $
fromGraphQL (Type.Int 5) `shouldBe` Just (5 :: Int) fromGraphQL (Type.Int 5) `shouldBe` Just (5 :: Int)
@ -45,3 +56,12 @@ spec = do
it "converts singleton lists" $ it "converts singleton lists" $
fromGraphQL (Type.List [Type.Boolean True]) `shouldBe` Just [True] 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