Add singleError utility function
This commit is contained in:
		
							
								
								
									
										27
									
								
								CHANGELOG.md
									
									
									
									
									
								
							
							
						
						
									
										27
									
								
								CHANGELOG.md
									
									
									
									
									
								
							@@ -1,6 +1,26 @@
 | 
				
			|||||||
# Change Log
 | 
					# Change Log
 | 
				
			||||||
All notable changes to this project will be documented in this file.
 | 
					All notable changes to this project will be documented in this file.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					## [0.4.0.0] - 2019-07-23
 | 
				
			||||||
 | 
					### Added
 | 
				
			||||||
 | 
					- Support for mutations.
 | 
				
			||||||
 | 
					- Error handling (with monad transformers).
 | 
				
			||||||
 | 
					- Nullable types.
 | 
				
			||||||
 | 
					- Arbitrary nested lists support.
 | 
				
			||||||
 | 
					- Potential BOM header parsing.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					### Changed
 | 
				
			||||||
 | 
					- attoparsec is replaced with megaparsec.
 | 
				
			||||||
 | 
					- The library is now under `Language.GraphQL` (instead of `Data.GraphQL`).
 | 
				
			||||||
 | 
					- HUnit and tasty are replaced with Hspec.
 | 
				
			||||||
 | 
					- `Alternative`/`MonadPlus` resolver constraints are replaced with `MonadIO`.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					### Removed
 | 
				
			||||||
 | 
					- Duplicates from `Language.GraphQL.AST` already available in
 | 
				
			||||||
 | 
					  `Language.GraphQL.AST.Core`.
 | 
				
			||||||
 | 
					- All module exports are now explicit, so private and help functions aren't
 | 
				
			||||||
 | 
					  exported anymore.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
## [0.3] - 2015-09-22
 | 
					## [0.3] - 2015-09-22
 | 
				
			||||||
### Changed
 | 
					### Changed
 | 
				
			||||||
- Exact match numeric types to spec.
 | 
					- Exact match numeric types to spec.
 | 
				
			||||||
@@ -33,6 +53,7 @@ All notable changes to this project will be documented in this file.
 | 
				
			|||||||
### Added
 | 
					### Added
 | 
				
			||||||
- Data types for the GraphQL language.
 | 
					- Data types for the GraphQL language.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[0.3]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2.1...v0.3
 | 
					[0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0
 | 
				
			||||||
[0.2.1]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2...v0.2.1
 | 
					[0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3
 | 
				
			||||||
[0.2]: https://github.com/jdnavarro/graphql-haskell/compare/v0.1...v0.2
 | 
					[0.2.1]: https://github.com/caraus-ecms/graphql/compare/v0.2...v0.2.1
 | 
				
			||||||
 | 
					[0.2]: https://github.com/caraus-ecms/graphql/compare/v0.1...v0.2
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -4,14 +4,14 @@ cabal-version: 1.12
 | 
				
			|||||||
--
 | 
					--
 | 
				
			||||||
-- see: https://github.com/sol/hpack
 | 
					-- see: https://github.com/sol/hpack
 | 
				
			||||||
--
 | 
					--
 | 
				
			||||||
-- hash: 0738bb4bfceb40525227c29cb0c32d360f528ba3a84890817c65f5950e37b311
 | 
					-- hash: dca80d6bcaa432cabc2499efc9f047c6f59546bc2ba75b35fed6efd694895598
 | 
				
			||||||
 | 
					
 | 
				
			||||||
name:           graphql
 | 
					name:           graphql
 | 
				
			||||||
version:        0.4.0.0
 | 
					version:        0.4.0.0
 | 
				
			||||||
synopsis:       Haskell GraphQL implementation
 | 
					synopsis:       Haskell GraphQL implementation
 | 
				
			||||||
description:    This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 | 
					description:    This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 | 
				
			||||||
category:       Language
 | 
					category:       Language
 | 
				
			||||||
homepage:       https://github.com/jdnavarro/graphql-haskell
 | 
					homepage:       https://github.com/caraus-ecms/graphql#readme
 | 
				
			||||||
bug-reports:    https://github.com/caraus-ecms/graphql/issues
 | 
					bug-reports:    https://github.com/caraus-ecms/graphql/issues
 | 
				
			||||||
author:         Danny Navarro <j@dannynavarro.net>,
 | 
					author:         Danny Navarro <j@dannynavarro.net>,
 | 
				
			||||||
                Matthías Páll Gissurarson <mpg@mpg.is>,
 | 
					                Matthías Páll Gissurarson <mpg@mpg.is>,
 | 
				
			||||||
@@ -66,6 +66,7 @@ test-suite tasty
 | 
				
			|||||||
  type: exitcode-stdio-1.0
 | 
					  type: exitcode-stdio-1.0
 | 
				
			||||||
  main-is: Spec.hs
 | 
					  main-is: Spec.hs
 | 
				
			||||||
  other-modules:
 | 
					  other-modules:
 | 
				
			||||||
 | 
					      Language.GraphQL.ErrorSpec
 | 
				
			||||||
      Language.GraphQL.LexerSpec
 | 
					      Language.GraphQL.LexerSpec
 | 
				
			||||||
      Language.GraphQL.ParserSpec
 | 
					      Language.GraphQL.ParserSpec
 | 
				
			||||||
      Test.KitchenSinkSpec
 | 
					      Test.KitchenSinkSpec
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -4,7 +4,6 @@ synopsis:            Haskell GraphQL implementation
 | 
				
			|||||||
description:
 | 
					description:
 | 
				
			||||||
  This package provides a rudimentary parser for the
 | 
					  This package provides a rudimentary parser for the
 | 
				
			||||||
  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 | 
					  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 | 
				
			||||||
homepage:            https://github.com/jdnavarro/graphql-haskell
 | 
					 | 
				
			||||||
maintainer:          belka@caraus.de
 | 
					maintainer:          belka@caraus.de
 | 
				
			||||||
github:              caraus-ecms/graphql
 | 
					github:              caraus-ecms/graphql
 | 
				
			||||||
category:            Language
 | 
					category:            Language
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -7,6 +7,7 @@ module Language.GraphQL.Error
 | 
				
			|||||||
    , addErrMsg
 | 
					    , addErrMsg
 | 
				
			||||||
    , runCollectErrs
 | 
					    , runCollectErrs
 | 
				
			||||||
    , runAppendErrs
 | 
					    , runAppendErrs
 | 
				
			||||||
 | 
					    , singleError
 | 
				
			||||||
    ) where
 | 
					    ) where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import qualified Data.Aeson as Aeson
 | 
					import qualified Data.Aeson as Aeson
 | 
				
			||||||
@@ -46,12 +47,19 @@ type CollectErrsT m = StateT [Aeson.Value] m
 | 
				
			|||||||
addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
 | 
					addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
 | 
				
			||||||
addErr v = modify (v :)
 | 
					addErr v = modify (v :)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
makeErrorMsg :: Text -> Aeson.Value
 | 
					makeErrorMessage :: Text -> Aeson.Value
 | 
				
			||||||
makeErrorMsg s = Aeson.object [("message", Aeson.toJSON s)]
 | 
					makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- | Constructs a response object containing only the error with the given
 | 
				
			||||||
 | 
					--   message.
 | 
				
			||||||
 | 
					singleError :: Text -> Aeson.Value
 | 
				
			||||||
 | 
					singleError message = Aeson.object
 | 
				
			||||||
 | 
					    [ ("errors", Aeson.toJSON [makeErrorMessage message])
 | 
				
			||||||
 | 
					    ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Convenience function for just wrapping an error message.
 | 
					-- | Convenience function for just wrapping an error message.
 | 
				
			||||||
addErrMsg :: Monad m => Text -> CollectErrsT m ()
 | 
					addErrMsg :: Monad m => Text -> CollectErrsT m ()
 | 
				
			||||||
addErrMsg = addErr . makeErrorMsg
 | 
					addErrMsg = addErr . makeErrorMessage
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Appends the given list of errors to the current list of errors.
 | 
					-- | Appends the given list of errors to the current list of errors.
 | 
				
			||||||
appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
 | 
					appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -29,15 +29,11 @@ execute
 | 
				
			|||||||
execute schema subs doc =
 | 
					execute schema subs doc =
 | 
				
			||||||
    maybe transformError (document schema) $ Transform.document subs doc
 | 
					    maybe transformError (document schema) $ Transform.document subs doc
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
    transformError = return $ Aeson.object
 | 
					    transformError = return $ singleError "Schema transformation error."
 | 
				
			||||||
        [("errors", Aeson.toJSON
 | 
					 | 
				
			||||||
            [ Aeson.object [("message", "Schema transformation error.")]
 | 
					 | 
				
			||||||
            ]
 | 
					 | 
				
			||||||
        )]
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
document :: MonadIO m => Schema m -> AST.Core.Document -> m Aeson.Value
 | 
					document :: MonadIO m => Schema m -> AST.Core.Document -> m Aeson.Value
 | 
				
			||||||
document schema (op :| []) = operation schema op
 | 
					document schema (op :| []) = operation schema op
 | 
				
			||||||
document _ _ = error "Multiple operations not supported yet"
 | 
					document _ _ = return $ singleError "Multiple operations not supported yet."
 | 
				
			||||||
 | 
					
 | 
				
			||||||
operation :: MonadIO m => Schema m -> AST.Core.Operation -> m Aeson.Value
 | 
					operation :: MonadIO m => Schema m -> AST.Core.Operation -> m Aeson.Value
 | 
				
			||||||
operation schema (AST.Core.Query flds)
 | 
					operation schema (AST.Core.Query flds)
 | 
				
			||||||
 
 | 
				
			|||||||
							
								
								
									
										24
									
								
								tests/Language/GraphQL/ErrorSpec.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										24
									
								
								tests/Language/GraphQL/ErrorSpec.hs
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,24 @@
 | 
				
			|||||||
 | 
					{-# LANGUAGE OverloadedStrings #-}
 | 
				
			||||||
 | 
					module Language.GraphQL.ErrorSpec
 | 
				
			||||||
 | 
					    ( spec
 | 
				
			||||||
 | 
					    ) where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					import qualified Data.Aeson as Aeson
 | 
				
			||||||
 | 
					import Language.GraphQL.Error
 | 
				
			||||||
 | 
					import Test.Hspec ( Spec
 | 
				
			||||||
 | 
					                  , describe
 | 
				
			||||||
 | 
					                  , it
 | 
				
			||||||
 | 
					                  , shouldBe
 | 
				
			||||||
 | 
					                  )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					spec :: Spec
 | 
				
			||||||
 | 
					spec = describe "singleError" $
 | 
				
			||||||
 | 
					    it "constructs an error with the given message" $
 | 
				
			||||||
 | 
					        let expected = Aeson.object
 | 
				
			||||||
 | 
					                [
 | 
				
			||||||
 | 
					                    ("errors", Aeson.toJSON
 | 
				
			||||||
 | 
					                        [ Aeson.object [("message", "Message.")]
 | 
				
			||||||
 | 
					                        ]
 | 
				
			||||||
 | 
					                    )
 | 
				
			||||||
 | 
					                ]
 | 
				
			||||||
 | 
					         in singleError "Message." `shouldBe` expected
 | 
				
			||||||
		Reference in New Issue
	
	Block a user