{- 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 ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Test helpers.
module Test.Hspec.GraphQL
    ( shouldResolve
    , shouldResolveTo
    ) where

import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL.Error
import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy)

-- | Asserts that a query resolves to some value.
shouldResolveTo :: MonadCatch m
    => Either (ResponseEventStream m Aeson.Value) Aeson.Object
    -> Aeson.Object
    -> Expectation
shouldResolveTo :: Either (ResponseEventStream m Value) Object
-> Object -> Expectation
shouldResolveTo (Right actual :: Object
actual) expected :: Object
expected = Object
actual Object -> Object -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Object
expected
shouldResolveTo _ _ = HasCallStack => String -> Expectation
String -> Expectation
expectationFailure
    "the query is expected to resolve to a value, but it resolved to an event stream"

-- | Asserts that the response doesn't contain any errors.
shouldResolve :: MonadCatch m
    => (Text -> IO (Either (ResponseEventStream m Aeson.Value) Aeson.Object))
    -> Text
    -> Expectation
shouldResolve :: (Text -> IO (Either (ResponseEventStream m Value) Object))
-> Text -> Expectation
shouldResolve executor :: Text -> IO (Either (ResponseEventStream m Value) Object)
executor query :: Text
query = do
    Either (ResponseEventStream m Value) Object
actual <- Text -> IO (Either (ResponseEventStream m Value) Object)
executor Text
query
    case Either (ResponseEventStream m Value) Object
actual of
        Right response :: Object
response ->
            Object
response Object -> (Object -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldNotSatisfy` Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member "errors"
        _ -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure
            "the query is expected to resolve to a value, but it resolved to an event stream"