Add singleError utility functionv0.4.0.0

6 files changed, 64 insertions, 15 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 21ed453..03743f3 100644
--- a/CHANGELOG.md
+++ b/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
diff --git a/graphql.cabal b/graphql.cabal
index 510e3da..dc4bf54 100644
--- a/graphql.cabal
+++ b/graphql.cabal
@@ -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
diff --git a/package.yaml b/package.yaml
index 5ffb72e..814d8c3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -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
diff --git a/src/Language/GraphQL/Error.hs b/src/Language/GraphQL/Error.hs
index 69fc8db..d0bc84d 100644
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@@ -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 ()
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 2a1ff97..9dbfb36 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -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)
diff --git a/tests/Language/GraphQL/ErrorSpec.hs b/tests/Language/GraphQL/ErrorSpec.hs
new file mode 100644
index 0000000..8bb39ed
--- /dev/null
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@@ -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