Release new instances as 1.0.2.0

CHANGELOG.md

@@ -6,6 +6,16 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
+## [1.0.2.0] - 2023-07-07
+### Added
+- `ToGraphQL` and `FromGraphQL` instances for `Word` types, `Float`, `Double`,
+  and `Scientific`.
+- `ToGraphQL` and `FromGraphQL` instances for `Day`, `DiffTime`,
+  `NominalDiffTime`, `UTCTime`, `LocalTime` and `TimeOfDay`.
+- `Resolver`: Export `ServerException`.
+- `Resolver.defaultResolver`: Throw `FieldNotResolvedException` if the requested
+  field is not in the parent object.
+
 ## [1.0.1.0] - 2023-02-17
 ### Added
 - `ToGraphQL` and `FromGraphQL` typeclasses with instances for basic types.
@@ -16,4 +26,5 @@ and this project adheres to
 - 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
+[1.0.2.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.1.0...v1.0.2.0
+[1.0.1.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.0.0...v1.0.1.0

cabal.project

@@ -1,4 +0,0 @@
-packages:
-  .
-
-constraints: graphql -json

graphql-spice.cabal

@@ -1,13 +1,13 @@
 cabal-version:      2.4
 
 name:               graphql-spice
-version:            1.0.1.0
+version:            1.0.2.0
 synopsis:           GraphQL with batteries
-description:        Various extensions and convenience functions  for the core
+description:        Various extensions and convenience functions for the core
                     graphql package.
 category:           Language
-homepage:           https://www.caraus.tech/projects/pub-graphql-spice
+homepage:           https://git.caraus.tech/OSS/graphql-spice
-bug-reports:        https://www.caraus.tech/projects/pub-graphql-spice/issues
+bug-reports:        https://git.caraus.tech/OSS/graphql-spice/issues
 author:             Eugen Wissner <belka@caraus.de>
 maintainer:         belka@caraus.de
 copyright:          (c) 2021-2023 Eugen Wissner
@@ -16,11 +16,11 @@ license-files:      LICENSE
 build-type:         Simple
 extra-source-files: CHANGELOG.md
 tested-with:
-  GHC == 9.2.5
+  GHC == 9.2.8
 
 source-repository head
   type: git
-  location: git://caraus.tech/pub/graphql-spice.git
+  location: https://git.caraus.tech/OSS/graphql-spice.git
 
 library
     exposed-modules:
@@ -32,18 +32,19 @@ library
     hs-source-dirs:   src
     ghc-options: -Wall
     build-depends:
-      aeson ^>= 2.0.3,
+      aeson >= 2.0.3 && < 2.3,
       base >= 4.7 && < 5,
       conduit ^>= 1.3.4,
       containers ^>= 0.6.2,
       exceptions ^>= 0.10.4,
       hspec-expectations >= 0.8.2 && < 0.9,
-      graphql >= 1.0,
+      graphql >= 1.2,
       megaparsec >= 9.0 && < 10,
       scientific ^>= 0.3.7,
       text >= 1.2 && < 3,
-      transformers ^>= 0.5.6,
+      time >= 1.11.1,
-      vector ^>= 0.12.3,
+      transformers >= 0.5.6 && < 0.7,
+      vector >= 0.12 && < 0.14,
       unordered-containers ^>= 0.2.16
     default-language: Haskell2010
 
@@ -67,5 +68,6 @@ test-suite graphql-test
     hspec >= 2.9.1 && < 3,
     scientific,
     text,
+    time,
     unordered-containers
   default-language: Haskell2010

src/Language/GraphQL/Class.hs

@@ -14,10 +14,30 @@ module Language.GraphQL.Class
 import Data.Foldable (toList)
 import Data.Int (Int8, Int16, Int32, Int64)
 import Data.Text (Text)
+import Data.Word (Word8, Word16, Word32, Word64)
 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
+import Data.Scientific (Scientific, toRealFloat)
+import qualified Data.Text as Text
+import Data.Time
+    ( Day
+    , DiffTime
+    , LocalTime(..)
+    , NominalDiffTime
+    , TimeOfDay(..)
+    , UTCTime(..)
+    , showGregorian
+    , secondsToNominalDiffTime
+    , secondsToDiffTime
+    )
+import Data.Time.Format.ISO8601
+    ( ISO8601(..)
+    , formatParseM
+    , iso8601Format
+    , iso8601Show
+    )
 
 fromGraphQLToIntegral :: Integral a => Type.Value -> Maybe a
 fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value
@@ -27,79 +47,225 @@ fromGraphQLToIntegral (Type.String value) =
         _conversionError -> Nothing
 fromGraphQLToIntegral _ = Nothing
 
+iso8601ToGraphQL :: ISO8601 t => t -> Type.Value
+iso8601ToGraphQL = Type.String . Text.pack . iso8601Show
+
+fromGraphQLToISO8601 :: ISO8601 t => Type.Value -> Maybe t
+fromGraphQLToISO8601 (Type.String value') = formatParseM iso8601Format $ Text.unpack value'
+fromGraphQLToISO8601 _ = Nothing
+
 -- | Instances of this typeclass can be converted to GraphQL internal
 -- representation.
-class ToGraphQL a where
+class ToGraphQL a
+  where
     toGraphQL :: a -> Type.Value
 
-instance ToGraphQL Text where
+instance ToGraphQL Text
+  where
     toGraphQL = Type.String
 
-instance ToGraphQL Int where
+instance ToGraphQL Int
+  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Int8 where
+instance ToGraphQL Int8
+  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Int16 where
+instance ToGraphQL Int16
+  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Int32 where
+instance ToGraphQL Int32
+  where
     toGraphQL = Type.Int
 
-instance ToGraphQL Int64 where
+instance ToGraphQL Int64
+  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL a => ToGraphQL [a] where
+instance ToGraphQL Word
+  where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Word8
+  where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Word16
+  where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Word32
+  where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Word64
+  where
+    toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL a => ToGraphQL [a]
+  where
     toGraphQL = Type.List . fmap toGraphQL
 
-instance ToGraphQL a => ToGraphQL (Vector a) where
+instance ToGraphQL a => ToGraphQL (Vector a)
+  where
     toGraphQL = Type.List . toList . fmap toGraphQL
 
-instance ToGraphQL a => ToGraphQL (Maybe a) where
+instance ToGraphQL a => ToGraphQL (Maybe a)
+  where
     toGraphQL (Just justValue) = toGraphQL justValue
     toGraphQL Nothing = Type.Null
 
-instance ToGraphQL Bool where
+instance ToGraphQL Bool
+  where
     toGraphQL = Type.Boolean
 
+instance ToGraphQL Float
+  where
+    toGraphQL = Type.Float . realToFrac
+
+instance ToGraphQL Double
+  where
+    toGraphQL = Type.Float
+
+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 = iso8601ToGraphQL
+
+instance ToGraphQL TimeOfDay
+  where
+    toGraphQL = iso8601ToGraphQL
+
+instance ToGraphQL LocalTime
+  where
+    toGraphQL = iso8601ToGraphQL
+
 -- | Instances of this typeclass can be used to convert GraphQL internal
 -- representation to user-defined type.
-class FromGraphQL a where
+class FromGraphQL a
+  where
     fromGraphQL :: Type.Value -> Maybe a
 
-instance FromGraphQL Text where
+instance FromGraphQL Text
+  where
     fromGraphQL (Type.String value) = Just value
     fromGraphQL _ = Nothing
 
-instance FromGraphQL Int where
+instance FromGraphQL Int
+  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int8 where
+instance FromGraphQL Int8
+  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int16 where
+instance FromGraphQL Int16
+  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int32 where
+instance FromGraphQL Int32
+  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int64 where
+instance FromGraphQL Int64
+  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL a => FromGraphQL [a] where
+instance FromGraphQL Word
+  where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Word8
+  where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Word16
+  where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Word32
+  where
+    fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Word64
+  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
+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
+instance FromGraphQL a => FromGraphQL (Maybe a)
+  where
     fromGraphQL Type.Null = Just Nothing
     fromGraphQL value = Just <$> fromGraphQL value
 
-instance FromGraphQL Bool where
+instance FromGraphQL Bool
+  where
     fromGraphQL (Type.Boolean value) = Just value
     fromGraphQL _ = Nothing
+
+instance FromGraphQL Float
+  where
+    fromGraphQL (Type.Float value) = Just $ realToFrac value
+    fromGraphQL _ = Nothing
+
+instance FromGraphQL Double
+  where
+    fromGraphQL (Type.Float value) = Just value
+    fromGraphQL _ = Nothing
+
+instance FromGraphQL Scientific
+  where
+    fromGraphQL (Type.Float value) = Just $ realToFrac value
+    fromGraphQL _ = Nothing
+
+instance FromGraphQL Day
+  where
+    fromGraphQL = fromGraphQLToISO8601
+
+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 = fromGraphQLToISO8601
+
+instance FromGraphQL TimeOfDay
+  where
+    fromGraphQL = fromGraphQLToISO8601
+
+instance FromGraphQL LocalTime
+  where
+    fromGraphQL = fromGraphQLToISO8601

src/Language/GraphQL/Resolver.hs

@@ -6,13 +6,14 @@
 
 -- | Helper functions and exceptions to write resolvers.
 module Language.GraphQL.Resolver
-    ( argument
+    ( ServerException(..)
+    , argument
     , defaultResolver
     ) where
 
 import Control.Monad.Catch (Exception(..), MonadCatch(..), MonadThrow(..))
 import Control.Monad.Trans.Reader (ReaderT, asks)
-import Data.HashMap.Strict ((!))
+import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Typeable (cast)
@@ -49,7 +50,8 @@ defaultResolver :: MonadCatch m => Name -> Type.Resolve m
 defaultResolver fieldName = do
     values' <- asks Type.values
     case values' of
-        Type.Object objectValue -> pure $ objectValue ! fieldName
+        Type.Object objectValue
+            | Just result <- HashMap.lookup fieldName objectValue -> pure result
         _nonObject -> throwM $ FieldNotResolvedException fieldName
 
 -- | Takes an argument name, validates that the argument exists, and optionally

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