.gitea/deploy.awk

@@ -1,3 +0,0 @@
-END {
-    system("cabal upload --username belka --password "ENVIRON["HACKAGE_PASSWORD"]" "$0)
-}

.gitea/workflows/build.yml

@@ -1,33 +0,0 @@
-name: Build
-
-on:
-  push:
-    branches:
-      - '**'
-  pull_request:
-    branches: [master]
-
-jobs:
-  audit:
-    runs-on: buildenv
-    steps:
-      - uses: actions/checkout@v4
-      - run: hlint -- src tests
-
-  test:
-    runs-on: buildenv
-    steps:
-      - uses: actions/checkout@v4
-      - name: Install dependencies
-        run: cabal update
-      - name: Prepare system
-        run: cabal build graphql-test
-      - run: cabal test --test-show-details=streaming
-
-  doc:
-    runs-on: buildenv
-    steps:
-      - uses: actions/checkout@v4
-      - name: Install dependencies
-        run: cabal update
-      - run: cabal haddock --enable-documentation

.gitea/workflows/release.yml

@@ -1,17 +0,0 @@
-name: Release
-
-on:
-  push:
-    tags:
-      - '**'
-
-jobs:
-  release:
-    runs-on: buildenv
-    steps:
-      - uses: actions/checkout@v4
-      - name: Upload a candidate
-        env:
-          HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}
-        run: |
-          cabal sdist | awk -f .gitea/deploy.awk

CHANGELOG.md

@@ -6,43 +6,6 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
-## [Unreleased]
-### Removed
-- Deprecated `Language.GraphQL.Class.gql` (moved to `Language.GraphQL.TH`).
-
-### Added
-- `String` instances from `ToGraphQL` and `FromGraphQL`.
-
-## [1.0.6.0] - 2024-12-06
-### Added
-- `Language.GraphQL.Class.gql` is moved to `Language.GraphQL.TH` where it was
-  before in `graphql`.
-
-## [1.0.5.0] - 2024-11-21
-### Added
-- Add `ToGraphQL` and `FromGraphQL` instances for `Value` and `HashMap`.
-
-## [1.0.4.0] - 2024-10-24
-### Added
-- `gql` quasi quoter which generates a string literal with the first line
-  starting at the first column and all following lines indented relative to the
-  first line.
-
-## [1.0.3.0] - 2024-07-20
-### Added
-- Add `deriveToGraphQL` for deriving `ToGraphQL` instances automatically.
-- Add `deriveFromGraphQL`for deriving `FromGraphQL` instances automatically.
-
-## [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.
@@ -53,10 +16,4 @@ and this project adheres to
 - JSON serialization.
 - Test helpers.
 
-[Unreleased]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.6.0...master
+[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.6.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.5.0...v1.0.6.0
-[1.0.5.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.4.0...v1.0.5.0
-[1.0.4.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.3.0...v1.0.4.0
-[1.0.3.0]: https://git.caraus.tech/OSS/graphql-spice/compare/v1.0.2.0...v1.0.3.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

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

graphql-spice.cabal

@@ -1,52 +1,49 @@
-cabal-version:      3.0
+cabal-version:      2.4
 
 name:               graphql-spice
-version:            1.0.6.0
+version:            1.0.1.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://git.caraus.tech/OSS/graphql-spice
+homepage:           https://www.caraus.tech/projects/pub-graphql-spice
-bug-reports:        https://git.caraus.tech/OSS/graphql-spice/issues
+bug-reports:        https://www.caraus.tech/projects/pub-graphql-spice/issues
 author:             Eugen Wissner <belka@caraus.de>
 maintainer:         belka@caraus.de
-copyright:          (c) 2021-2024 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 == 9.8.2
+  GHC == 9.2.5
 
 source-repository head
   type: git
-  location: https://git.caraus.tech/OSS/graphql-spice.git
+  location: git://caraus.tech/pub/graphql-spice.git
 
 library
     exposed-modules:
       Language.GraphQL.Class
       Language.GraphQL.JSON
       Language.GraphQL.Resolver
-      Language.GraphQL.TH
       Test.Hspec.GraphQL
     other-modules:
     hs-source-dirs:   src
     ghc-options: -Wall
     build-depends:
-      aeson >= 2.0.3 && < 2.3,
+      aeson ^>= 2.0.3,
       base >= 4.7 && < 5,
       conduit ^>= 1.3.4,
-      containers >= 0.6 && < 0.8,
+      containers ^>= 0.6.2,
       exceptions ^>= 0.10.4,
       hspec-expectations >= 0.8.2 && < 0.9,
-      graphql ^>= 1.5.0,
+      graphql >= 1.0,
       megaparsec >= 9.0 && < 10,
       scientific ^>= 0.3.7,
-      template-haskell >= 2.16 && < 3,
       text >= 1.2 && < 3,
-      time >= 1.12.2 && < 1.15,
+      transformers ^>= 0.5.6,
-      transformers >= 0.5.6 && < 0.7,
+      vector ^>= 0.12.3,
-      vector >= 0.12 && < 0.14,
       unordered-containers ^>= 0.2.16
     default-language: Haskell2010
 
@@ -59,7 +56,6 @@ test-suite graphql-test
     Language.GraphQL.DirectiveSpec
     Language.GraphQL.FragmentSpec
     Language.GraphQL.RootOperationSpec
-    Language.GraphQL.THSpec
   hs-source-dirs:
     tests
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
@@ -71,8 +67,5 @@ test-suite graphql-test
     hspec >= 2.9.1 && < 3,
     scientific,
     text,
-    time,
     unordered-containers
-  build-tool-depends:
-    hspec-discover:hspec-discover
   default-language: Haskell2010

src/Language/GraphQL/Class.hs

@@ -3,80 +3,21 @@
    obtain one at https://mozilla.org/MPL/2.0/. -}
 
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 -- | ToGraphQL and FromGraphQL typeclasses used for user-defined type
 -- conversion.
 module Language.GraphQL.Class
     ( FromGraphQL(..)
     , ToGraphQL(..)
-    , deriveFromGraphQL
-    , deriveToGraphQL
     ) where
 
+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 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
-    )
-import Language.Haskell.TH
-    ( Con(..)
-    , Dec(..)
-    , Exp(..)
-    , Info(..)
-    , Quote(..)
-    , Name
-    , Q
-    , VarBangType
-    , appT
-    , conP
-    , conT
-    , instanceD
-    , recP
-    , reify
-    , nameBase
-    , listE
-    , stringL
-    , tupE
-    , litE
-    , varE
-    , varP
-    , funD
-    , clause
-    , normalB
-    , appE
-    , mkName
-    , conE
-    , integerL
-    , litP
-    , wildP
-    )
-import Data.Foldable (Foldable(..))
-import qualified Data.HashMap.Strict as HashMap
 import qualified Language.GraphQL.Type as Type
-import Prelude hiding (id)
 
 fromGraphQLToIntegral :: Integral a => Type.Value -> Maybe a
 fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value
@@ -86,382 +27,79 @@ 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
+class ToGraphQL a where
-  where
     toGraphQL :: a -> Type.Value
 
-instance ToGraphQL Type.Value
+instance ToGraphQL Text where
-  where
-    toGraphQL a = a
-
-instance ToGraphQL Text
-  where
     toGraphQL = Type.String
 
-instance ToGraphQL String
+instance ToGraphQL Int where
-  where
-    toGraphQL = Type.String . Text.pack
-
-instance ToGraphQL Int
-  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Int8
+instance ToGraphQL Int8 where
-  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Int16
+instance ToGraphQL Int16 where
-  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Int32
+instance ToGraphQL Int32 where
-  where
     toGraphQL = Type.Int
 
-instance ToGraphQL Int64
+instance ToGraphQL Int64 where
-  where
     toGraphQL = Type.Int . fromIntegral
 
-instance ToGraphQL Word
+instance ToGraphQL a => ToGraphQL [a] where
-  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)
+instance ToGraphQL a => ToGraphQL (Vector a) where
-  where
     toGraphQL = Type.List . toList . fmap toGraphQL
 
-instance ToGraphQL a => ToGraphQL (Maybe a)
+instance ToGraphQL a => ToGraphQL (Maybe a) where
-  where
     toGraphQL (Just justValue) = toGraphQL justValue
     toGraphQL Nothing = Type.Null
 
-instance ToGraphQL Bool
+instance ToGraphQL Bool where
-  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
-
-instance ToGraphQL a => ToGraphQL (HashMap.HashMap Text a)
-  where
-    toGraphQL = Type.Object . fmap toGraphQL
-
 -- | Instances of this typeclass can be used to convert GraphQL internal
 -- representation to user-defined type.
-class FromGraphQL a
+class FromGraphQL a where
-  where
     fromGraphQL :: Type.Value -> Maybe a
 
-instance FromGraphQL Type.Value
+instance FromGraphQL Text where
-  where
-    fromGraphQL = Just
-
-instance FromGraphQL Text
-  where
     fromGraphQL (Type.String value) = Just value
     fromGraphQL _ = Nothing
 
-instance FromGraphQL String
+instance FromGraphQL Int where
-  where
-    fromGraphQL (Type.String value) = Just $ Text.unpack value
-    fromGraphQL _ = Nothing
-
-instance FromGraphQL Int
-  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int8
+instance FromGraphQL Int8 where
-  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int16
+instance FromGraphQL Int16 where
-  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int32
+instance FromGraphQL Int32 where
-  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Int64
+instance FromGraphQL Int64 where
-  where
     fromGraphQL = fromGraphQLToIntegral
 
-instance FromGraphQL Word
+instance FromGraphQL a => FromGraphQL [a] where
-  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)
+instance FromGraphQL a => FromGraphQL (Vector a) where
-  where
     fromGraphQL (Type.List value) = Vector.fromList
         <$> traverse fromGraphQL value
     fromGraphQL _ = Nothing
 
-instance FromGraphQL a => FromGraphQL (Maybe a)
+instance FromGraphQL a => FromGraphQL (Maybe a) where
-  where
     fromGraphQL Type.Null = Just Nothing
     fromGraphQL value = Just <$> fromGraphQL value
 
-instance FromGraphQL Bool
+instance FromGraphQL Bool where
-  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
-
-instance FromGraphQL a => FromGraphQL (HashMap.HashMap Text a)
-  where
-    fromGraphQL (Type.Object hm) = traverse fromGraphQL hm
-    fromGraphQL _ = Nothing
-
-stringLE :: Name -> Q Exp
-stringLE = litE . stringL . nameBase
-
--- | Given a type derives a 'FromGraphQL' instance for it.
---
--- The derivation can only work when all nested types already have 'FromGraphQL'
--- instances.
---
--- The following cases are supported:
---
--- * Records encode input objects.
--- * Sum types with all data constructors without parameters encode Enums.
-deriveFromGraphQL :: Name -> Q [Dec]
-deriveFromGraphQL typeName = do
-    TyConI plainConstructor <- reify typeName
-    case plainConstructor of
-        DataD _ _ _ _ [cons'] _
-            | RecC dataConName varBangTypes <- cons' ->
-                withRecordConstructor dataConName varBangTypes
-        DataD _ _ _ _ cons' _ -> pure <$> generateEnumInstance cons'
-        NewtypeD _ _ _ _ cons' _
-            | RecC dataConName varBangTypes <- cons' ->
-                withRecordConstructor dataConName varBangTypes
-        _ -> error "Only input objects and enums are supported if all member types have a FromGraphQL instance"
-  where
-    enumMemberPattern (NormalC normalName []) =
-        let fromGraphQLF = conP (mkName "Type.Enum") [litP $ stringL $ nameBase normalName]
-         in flip (clause [fromGraphQLF]) []
-            $ normalB [|Just $(conE normalName)|]
-    enumMemberPattern _ =
-        error "Enum member should be a normal constructor without parameters"
-    generateEnumInstance :: [Con] -> Q Dec
-    generateEnumInstance cons'
-        = instanceD mempty (appT (conT ''FromGraphQL) conTName)
-        $ pure $ funD 'fromGraphQL
-        $ (enumMemberPattern <$> cons')
-        <> [clause [wildP] (normalB [|Nothing|]) []]
-    hashMapLookup fieldName objectName =
-        [|HashMap.lookup $(stringLE fieldName) $objectName >>= fromGraphQL|]
-    addRecordField objectName accumulator (name', _, _)
-        = appE (appE (varE $ mkName "<*>") accumulator)
-        $ hashMapLookup name' objectName
-    withRecordConstructor dataConName varBangTypes = do
-        valueName <- newName "value"
-        let objectName = varE valueName
-            toGraphQLF = conP (mkName "Type.Object") [varP valueName]
-            fBody = makeRecordBody (conE dataConName) objectName varBangTypes
-            recordSize = litE $ integerL $ fromIntegral $ length varBangTypes
-        [d|
-            instance FromGraphQL $conTName
-              where
-                fromGraphQL $toGraphQLF
-                    | HashMap.size $objectName == $recordSize = $fBody
-                    | otherwise = Nothing
-                fromGraphQL _ = Nothing
-         |]
-    makeRecordBody dataConE objectName ((headName, _, _) : varBangTypes') =
-        let initialExpression = appE (appE (varE $ mkName "<$>") dataConE)
-                $ hashMapLookup headName objectName
-         in foldl' (addRecordField objectName) initialExpression varBangTypes'
-    makeRecordBody dataConE _ [] = dataConE
-    conTName = conT typeName
-
--- | Given a type derives a 'ToGraphQL' instance for it.
---
--- The derivation can only work when all nested types already have 'ToGraphQL'
--- instances.
---
--- The following cases are supported:
---
--- * Records are decoded as objects.
--- * Sum types with all data constructors without parameters are decoded as Enums.
--- * Sum types whose data constructors have exactly one parameter are decoded as Unions.
-deriveToGraphQL :: Name -> Q [Dec]
-deriveToGraphQL typeName = do
-    TyConI plainConstructor <- reify typeName
-    case plainConstructor of
-        DataD _ _ _ _ [cons'] _
-            | RecC dataConName varBangTypes <- cons' ->
-                withRecordConstructor dataConName varBangTypes
-        DataD _ _ _ _ cons' _ -> fmap pure
-            $ instanceD mempty (appT (conT ''ToGraphQL) conTName)
-            $ pure $ funD 'toGraphQL
-            $ generateSumTypeInstance cons'
-        NewtypeD _ _ _ _ cons' _
-            | RecC dataConName varBangTypes <- cons' ->
-                withRecordConstructor dataConName varBangTypes
-        _ -> error "Only objects, unions and enums are supported if all member types have a ToGraphQL instance"
-  where
-    conTName = conT typeName
-    collectEnumMemberNames (NormalC normalName []) = Just normalName
-    collectEnumMemberNames _ = Nothing
-    collectUnionMembers (NormalC normalName [_]) = Just normalName
-    collectUnionMembers _ = Nothing
-    enumMemberPattern normalName
-        = flip (clause [conP normalName mempty]) []
-        $ normalB [|Type.Enum $(stringLE normalName)|]
-    unionMemberPattern normalName = do
-        dataName <- newName "member"
-        flip (clause [conP normalName [varP dataName]]) []
-            $ normalB
-            $ appE (varE $ mkName "toGraphQL")
-            $ varE dataName
-    generateSumTypeInstance cons'
-        | Just enumMemberNames <- traverse collectEnumMemberNames cons' =
-            enumMemberPattern <$> enumMemberNames
-        | Just unionMembers <- traverse collectUnionMembers cons' =
-            unionMemberPattern <$> unionMembers
-        | otherwise =  error "All data constructors should have either no parameters (Enum) or one parameter (Union)"
-    withRecordConstructor dataConName varBangTypes = do
-        fieldAliases <- traverse newFieldAliases varBangTypes
-        let fBody =
-                [| Type.Object
-                    $ HashMap.insert "__typename" $(stringLE typeName)
-                    $ HashMap.fromList $(listE $ resultObjectPairs <$> fieldAliases)
-                |]
-            toGraphQLF = recP dataConName (newFieldPatterns <$> fieldAliases)
-        [d|
-            instance ToGraphQL $conTName
-              where
-                toGraphQL $toGraphQLF = $fBody
-         |]
-    newFieldAliases :: VarBangType -> Q (Name, Name)
-    newFieldAliases (name', _, _) = (name',) <$> newName (nameBase name')
-    newFieldPatterns (name', alias) = (name',) <$> varP alias
-    resultObjectPairs :: (Name, Name) -> Q Exp
-    resultObjectPairs (name', alias) = tupE
-        [ litE (stringL $ nameBase name')
-        , [|toGraphQL $(varE alias)|]
-        ]

src/Language/GraphQL/Resolver.hs

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

src/Language/GraphQL/TH.hs

@@ -1,49 +0,0 @@
-{- 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/. -}
-
-module Language.GraphQL.TH
-    ( gql
-    ) where
-
-import Language.Haskell.TH
-    ( Exp(..)
-    , Lit(..)
-    )
-import Language.Haskell.TH.Quote (QuasiQuoter(..))
-
-stripIndentation :: String -> String
-stripIndentation code = reverse
-    $ dropWhile isLineBreak
-    $ reverse
-    $ unlines
-    $ indent spaces <$> lines' withoutLeadingNewlines
-  where
-    indent 0 xs = xs
-    indent count (' ' : xs) = indent (count - 1) xs
-    indent _ xs = xs
-    withoutLeadingNewlines = dropWhile isLineBreak code
-    spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
-    lines' "" = []
-    lines' string =
-        let (line, rest) = break isLineBreak string
-            reminder =
-                case rest of
-                    [] -> []
-                    '\r' : '\n' : strippedString -> lines' strippedString
-                    _ : strippedString -> lines' strippedString
-         in line : reminder
-    isLineBreak = flip any ['\n', '\r'] . (==)
-
--- | Removes leading and trailing newlines. Indentation of the first line is
--- removed from each line of the string.
-gql :: QuasiQuoter
-gql = QuasiQuoter
-    { quoteExp = pure . LitE . StringL . stripIndentation
-    , quotePat = const
-        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a pattern)"
-    , quoteType = const
-        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a type)"
-    , quoteDec = const
-        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a declaration)"
-    }

tests/Language/GraphQL/ClassSpec.hs

@@ -3,52 +3,14 @@
    obtain one at https://mozilla.org/MPL/2.0/. -}
 
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-
 module Language.GraphQL.ClassSpec
     ( spec
     ) 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
+import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..))
-    ( FromGraphQL(..)
-    , ToGraphQL(..)
-    , deriveFromGraphQL
-    , deriveToGraphQL
-    )
 import Test.Hspec (Spec, describe, it, shouldBe)
-import qualified Data.HashMap.Strict as HashMap
-
-data TwoFieldRecord = TwoFieldRecord
-    { x :: Int
-    , y :: Bool
-    } deriving (Eq, Show)
-
-$(deriveToGraphQL ''TwoFieldRecord)
-$(deriveFromGraphQL ''TwoFieldRecord)
-
-data TwoVariantUnion
-    = FirstVariantUnion TwoFieldRecord
-    | SecondVariantUnion TwoFieldRecord
-    deriving (Eq, Show)
-
-$(deriveToGraphQL ''TwoVariantUnion)
-
-newtype NewTypeRecord = NewTypeRecord { newTypeField :: Int }
-    deriving (Eq, Show)
-
-$(deriveToGraphQL ''NewTypeRecord)
-$(deriveFromGraphQL ''NewTypeRecord)
-
-data TwoFieldEnum = TWO_FIELD_ENUM_1 | TWO_FIELD_ENUM_2
-    deriving (Eq, Show)
-
-$(deriveToGraphQL ''TwoFieldEnum)
-$(deriveFromGraphQL ''TwoFieldEnum)
 
 spec :: Spec
 spec = do
@@ -68,15 +30,6 @@ 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)
@@ -92,72 +45,3 @@ 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
-
-    describe "deriveToGraphQL" $ do
-        it "derives ToGraphQL for a record with multiple fields" $
-            let expected = Type.Object $ HashMap.fromList
-                    [ ("x", Type.Int 1)
-                    , ("y", Type.Boolean True)
-                    , ("__typename", Type.String "TwoFieldRecord")
-                    ]
-                given = TwoFieldRecord
-                    { x = 1
-                    , y = True
-                    }
-             in toGraphQL given `shouldBe` expected
-
-        it "derives ToGraphQL for a union" $
-            let expected = Type.Object $ HashMap.fromList
-                    [ ("x", Type.Int 2)
-                    , ("y", Type.Boolean False)
-                    , ("__typename", Type.String "TwoFieldRecord")
-                    ]
-                given = SecondVariantUnion $ TwoFieldRecord
-                    { x = 2
-                    , y = False
-                    }
-             in toGraphQL given `shouldBe` expected
-
-        it "derives ToGraphQL for a newtype record" $
-            let expected = Type.Object $ HashMap.fromList
-                    [ ("newTypeField", Type.Int 3)
-                    , ("__typename", Type.String "NewTypeRecord")
-                    ]
-                given = NewTypeRecord 3
-             in toGraphQL given `shouldBe` expected
-
-        it "derives ToGraphQL for an enumeration" $
-            let expected = Type.Enum "TWO_FIELD_ENUM_2"
-                given = TWO_FIELD_ENUM_2
-             in toGraphQL given `shouldBe` expected
-
-    describe "deriveFromGraphQL" $ do
-        it "derives FromGraphQL for a record with multiple fields" $
-            let given = Type.Object $ HashMap.fromList
-                    [ ("x", Type.Int 1)
-                    , ("y", Type.Boolean True)
-                    ]
-                expected = TwoFieldRecord
-                    { x = 1
-                    , y = True
-                    }
-             in fromGraphQL given `shouldBe` Just expected
-
-        it "derives FromGraphQL for a newtype record" $
-            let given = Type.Object $ HashMap.singleton "newTypeField" (Type.Int 3)
-                expected = NewTypeRecord 3
-             in fromGraphQL given `shouldBe` Just expected
-
-        it "derives FromGraphQL for an enumeration" $
-            let given = Type.Enum "TWO_FIELD_ENUM_2"
-                expected = TWO_FIELD_ENUM_2
-             in fromGraphQL given `shouldBe` Just expected

tests/Language/GraphQL/CoerceSpec.hs

@@ -3,7 +3,6 @@
    obtain one at https://mozilla.org/MPL/2.0/. -}
 
 {-# LANGUAGE OverloadedStrings #-}
-
 module Language.GraphQL.CoerceSpec
     ( spec
     ) where

tests/Language/GraphQL/DirectiveSpec.hs

@@ -4,6 +4,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE PackageImports #-}
 
 module Language.GraphQL.DirectiveSpec
     ( spec
@@ -17,7 +18,7 @@ import Language.GraphQL.TH
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
 import Test.Hspec (Spec, describe, it)
-import Test.Hspec.GraphQL
+import "graphql-spice" Test.Hspec.GraphQL
 
 experimentalResolver :: Schema IO
 experimentalResolver = schema queryType Nothing Nothing mempty

tests/Language/GraphQL/FragmentSpec.hs

@@ -4,6 +4,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE PackageImports #-}
 
 module Language.GraphQL.FragmentSpec
     ( spec
@@ -19,7 +20,7 @@ import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.TH
 import qualified Language.GraphQL as GraphQL
 import Test.Hspec (Spec, describe, it)
-import Test.Hspec.GraphQL
+import "graphql-spice" Test.Hspec.GraphQL
 
 size :: (Text, Value)
 size = ("size", String "L")

tests/Language/GraphQL/RootOperationSpec.hs

@@ -4,6 +4,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE PackageImports #-}
 
 module Language.GraphQL.RootOperationSpec
     ( spec
@@ -17,7 +18,7 @@ import Test.Hspec (Spec, describe, it)
 import Language.GraphQL.TH
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
-import Test.Hspec.GraphQL
+import "graphql-spice" Test.Hspec.GraphQL
 
 hatType :: Out.ObjectType IO
 hatType = Out.ObjectType "Hat" Nothing []

tests/Language/GraphQL/THSpec.hs

@@ -1,27 +0,0 @@
-{- 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 #-}
-{-# LANGUAGE QuasiQuotes #-}
-
-module Language.GraphQL.THSpec
-    ( spec
-    ) where
-
-import Data.Text (Text)
-import Language.GraphQL.TH (gql)
-import Test.Hspec (Spec, describe, it, shouldBe)
-
-spec :: Spec
-spec = do
-    describe "gql" $
-        it "replaces CRNL with NL" $
-            let expected :: Text
-                expected = "line1\nline2\nline3"
-                actual = [gql|
-                  line1
-                  line2
-                  line3
-                |]
-             in actual `shouldBe` expected