Compare commits
13 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | 6590cfaae8 | |
Eugen Wissner | a2c626870a | |
Eugen Wissner | c08cb59b21 | |
Eugen Wissner | 62cf943b87 | |
Eugen Wissner | 36f45861de | |
Eugen Wissner | f90feb488d | |
Eugen Wissner | 64d7545bc6 | |
Eugen Wissner | 4bd243b7ec | |
Eugen Wissner | 1b9d8af932 | |
Eugen Wissner | 7c146fe416 | |
Eugen Wissner | 5306730ff8 | |
Eugen Wissner | 92463f7c4a | |
Eugen Wissner | 53ce65d713 |
|
@ -0,0 +1,50 @@
|
|||
name: Build
|
||||
|
||||
on:
|
||||
push:
|
||||
pull_request:
|
||||
branches: [master]
|
||||
|
||||
jobs:
|
||||
audit:
|
||||
runs-on: haskell
|
||||
steps:
|
||||
- name: Set up environment
|
||||
run: |
|
||||
apt-get update -y
|
||||
apt-get upgrade -y
|
||||
apt-get install -y nodejs pkg-config
|
||||
- uses: actions/checkout@v4
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
cabal update
|
||||
cabal install hlint "--constraint=hlint ==3.8"
|
||||
- run: cabal exec hlint -- src tests
|
||||
|
||||
test:
|
||||
runs-on: haskell
|
||||
steps:
|
||||
- name: Set up environment
|
||||
run: |
|
||||
apt-get update -y
|
||||
apt-get upgrade -y
|
||||
apt-get install -y nodejs pkg-config
|
||||
- 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: haskell
|
||||
steps:
|
||||
- name: Set up environment
|
||||
run: |
|
||||
apt-get update -y
|
||||
apt-get upgrade -y
|
||||
apt-get install -y nodejs pkg-config
|
||||
- uses: actions/checkout@v4
|
||||
- name: Install dependencies
|
||||
run: cabal update
|
||||
- run: cabal haddock --enable-documentation
|
20
CHANGELOG.md
20
CHANGELOG.md
|
@ -6,7 +6,25 @@ The format is based on
|
|||
and this project adheres to
|
||||
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
|
||||
|
||||
## [1.0.0.0] - 2022-03-29
|
||||
## [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.
|
||||
- `Resolver` module with `argument` and `defaultResolver` helper functions.
|
||||
|
||||
## 1.0.0.0 - 2022-03-29
|
||||
### Added
|
||||
- JSON serialization.
|
||||
- Test helpers.
|
||||
|
||||
[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
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
packages:
|
||||
.
|
||||
|
||||
constraints: graphql -json
|
|
@ -1,46 +1,50 @@
|
|||
cabal-version: 2.4
|
||||
|
||||
name: graphql-spice
|
||||
version: 1.0.0.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
|
||||
bug-reports: https://www.caraus.tech/projects/pub-graphql-spice/issues
|
||||
homepage: https://git.caraus.tech/OSS/graphql-spice
|
||||
bug-reports: https://git.caraus.tech/OSS/graphql-spice/issues
|
||||
author: Eugen Wissner <belka@caraus.de>
|
||||
maintainer: belka@caraus.de
|
||||
copyright: (c) 2021-2022 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 == 8.10.7
|
||||
GHC == 9.4.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:
|
||||
Language.GraphQL.JSON,
|
||||
Language.GraphQL.Class
|
||||
Language.GraphQL.JSON
|
||||
Language.GraphQL.Resolver
|
||||
Test.Hspec.GraphQL
|
||||
other-modules:
|
||||
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.3.0,
|
||||
graphql >= 1.2,
|
||||
megaparsec >= 9.0 && < 10,
|
||||
scientific ^>= 0.3.7,
|
||||
text >= 1.2 && < 3,
|
||||
vector ^>= 0.12.3,
|
||||
time >= 1.11.1,
|
||||
transformers >= 0.5.6 && < 0.7,
|
||||
vector >= 0.12 && < 0.14,
|
||||
unordered-containers ^>= 0.2.16
|
||||
default-language: Haskell2010
|
||||
|
||||
|
@ -48,6 +52,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
|
||||
|
@ -63,5 +68,8 @@ test-suite graphql-test
|
|||
hspec >= 2.9.1 && < 3,
|
||||
scientific,
|
||||
text,
|
||||
time,
|
||||
unordered-containers
|
||||
build-tool-depends:
|
||||
hspec-discover:hspec-discover
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -0,0 +1,271 @@
|
|||
{- 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 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
|
||||
fromGraphQLToIntegral (Type.String value) =
|
||||
case Text.Read.decimal value of
|
||||
Right (converted, "") -> Just converted
|
||||
_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
|
||||
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 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
|
||||
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
|
||||
|
||||
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
|
||||
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 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
|
||||
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
|
||||
|
||||
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
|
|
@ -0,0 +1,63 @@
|
|||
{- 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 #-}
|
||||
|
||||
-- | Helper functions and exceptions to write resolvers.
|
||||
module Language.GraphQL.Resolver
|
||||
( ServerException(..)
|
||||
, 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.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Typeable (cast)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Error
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import Language.GraphQL.Class (FromGraphQL(..))
|
||||
|
||||
-- | Exceptions thrown by the functions in this module.
|
||||
data ServerException
|
||||
= FieldNotResolvedException !Text
|
||||
| ErroneousArgumentTypeException !Text
|
||||
|
||||
instance Show ServerException where
|
||||
show (FieldNotResolvedException fieldName) =
|
||||
Text.unpack $ Text.unwords ["Field", fieldName, "not resolved."]
|
||||
show (ErroneousArgumentTypeException argumentName) =
|
||||
Text.unpack $ Text.unwords
|
||||
[ "Unable to convert the argument"
|
||||
, argumentName
|
||||
, "to a user-defined type."
|
||||
]
|
||||
|
||||
instance Exception ServerException where
|
||||
toException = toException . ResolverException
|
||||
fromException x = do
|
||||
ResolverException a <- fromException x
|
||||
cast a
|
||||
|
||||
-- | Default resolver expects that the field value is returned by the parent
|
||||
-- object. If the parent is not an object or it doesn't contain the requested
|
||||
-- field name, an error is thrown.
|
||||
defaultResolver :: MonadCatch m => Name -> Type.Resolve m
|
||||
defaultResolver fieldName = do
|
||||
values' <- asks Type.values
|
||||
case values' of
|
||||
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
|
||||
-- converts it to a user-defined type.
|
||||
argument :: (MonadCatch m, FromGraphQL a) => Name -> ReaderT Type.Context m a
|
||||
argument argumentName =
|
||||
Type.argument argumentName >>= maybe throwError pure . fromGraphQL
|
||||
where
|
||||
throwError = throwM $ ErroneousArgumentTypeException argumentName
|
|
@ -0,0 +1,67 @@
|
|||
{- 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 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)
|
||||
|
||||
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]
|
||||
|
||||
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)
|
||||
|
||||
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]
|
||||
|
||||
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
|
Loading…
Reference in New Issue