Add singleError utility function
This commit is contained in:
		
							
								
								
									
										27
									
								
								CHANGELOG.md
									
									
									
									
									
								
							
							
						
						
									
										27
									
								
								CHANGELOG.md
									
									
									
									
									
								
							@@ -1,6 +1,26 @@
 | 
			
		||||
# Change Log
 | 
			
		||||
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
 | 
			
		||||
### Changed
 | 
			
		||||
- Exact match numeric types to spec.
 | 
			
		||||
@@ -33,6 +53,7 @@ All notable changes to this project will be documented in this file.
 | 
			
		||||
### Added
 | 
			
		||||
- Data types for the GraphQL language.
 | 
			
		||||
 | 
			
		||||
[0.3]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2.1...v0.3
 | 
			
		||||
[0.2.1]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2...v0.2.1
 | 
			
		||||
[0.2]: https://github.com/jdnavarro/graphql-haskell/compare/v0.1...v0.2
 | 
			
		||||
[0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0
 | 
			
		||||
[0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3
 | 
			
		||||
[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
 | 
			
		||||
--
 | 
			
		||||
-- hash: 0738bb4bfceb40525227c29cb0c32d360f528ba3a84890817c65f5950e37b311
 | 
			
		||||
-- hash: dca80d6bcaa432cabc2499efc9f047c6f59546bc2ba75b35fed6efd694895598
 | 
			
		||||
 | 
			
		||||
name:           graphql
 | 
			
		||||
version:        0.4.0.0
 | 
			
		||||
synopsis:       Haskell GraphQL implementation
 | 
			
		||||
description:    This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> 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
 | 
			
		||||
author:         Danny Navarro <j@dannynavarro.net>,
 | 
			
		||||
                Matthías Páll Gissurarson <mpg@mpg.is>,
 | 
			
		||||
@@ -66,6 +66,7 @@ test-suite tasty
 | 
			
		||||
  type: exitcode-stdio-1.0
 | 
			
		||||
  main-is: Spec.hs
 | 
			
		||||
  other-modules:
 | 
			
		||||
      Language.GraphQL.ErrorSpec
 | 
			
		||||
      Language.GraphQL.LexerSpec
 | 
			
		||||
      Language.GraphQL.ParserSpec
 | 
			
		||||
      Test.KitchenSinkSpec
 | 
			
		||||
 
 | 
			
		||||
@@ -4,7 +4,6 @@ synopsis:            Haskell GraphQL implementation
 | 
			
		||||
description:
 | 
			
		||||
  This package provides a rudimentary parser for the
 | 
			
		||||
  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 | 
			
		||||
homepage:            https://github.com/jdnavarro/graphql-haskell
 | 
			
		||||
maintainer:          belka@caraus.de
 | 
			
		||||
github:              caraus-ecms/graphql
 | 
			
		||||
category:            Language
 | 
			
		||||
 
 | 
			
		||||
@@ -7,6 +7,7 @@ module Language.GraphQL.Error
 | 
			
		||||
    , addErrMsg
 | 
			
		||||
    , runCollectErrs
 | 
			
		||||
    , runAppendErrs
 | 
			
		||||
    , singleError
 | 
			
		||||
    ) where
 | 
			
		||||
 | 
			
		||||
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 v = modify (v :)
 | 
			
		||||
 | 
			
		||||
makeErrorMsg :: Text -> Aeson.Value
 | 
			
		||||
makeErrorMsg s = Aeson.object [("message", Aeson.toJSON s)]
 | 
			
		||||
makeErrorMessage :: Text -> Aeson.Value
 | 
			
		||||
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.
 | 
			
		||||
addErrMsg :: Monad m => Text -> CollectErrsT m ()
 | 
			
		||||
addErrMsg = addErr . makeErrorMsg
 | 
			
		||||
addErrMsg = addErr . makeErrorMessage
 | 
			
		||||
 | 
			
		||||
-- | Appends the given list of errors to the current list of errors.
 | 
			
		||||
appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
 | 
			
		||||
 
 | 
			
		||||
@@ -29,15 +29,11 @@ execute
 | 
			
		||||
execute schema subs doc =
 | 
			
		||||
    maybe transformError (document schema) $ Transform.document subs doc
 | 
			
		||||
  where
 | 
			
		||||
    transformError = return $ Aeson.object
 | 
			
		||||
        [("errors", Aeson.toJSON
 | 
			
		||||
            [ Aeson.object [("message", "Schema transformation error.")]
 | 
			
		||||
            ]
 | 
			
		||||
        )]
 | 
			
		||||
    transformError = return $ singleError "Schema transformation error."
 | 
			
		||||
 | 
			
		||||
document :: MonadIO m => Schema m -> AST.Core.Document -> m Aeson.Value
 | 
			
		||||
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 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