{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Test.Morpheus.Response
  ( assertResponse,
    getQuery,
    fromEither,
    expects,
  )
where

import Data.Aeson
  ( FromJSON (..),
    Result (..),
    ToJSON (..),
    Value (..),
    decode,
    eitherDecode,
    fromJSON,
    object,
    (.=),
  )
import Relude hiding (ByteString)
import Test.Morpheus.File (FileUrl (fileName), readGQL, readJSON)
import Test.Morpheus.JSONDiff
import Test.Tasty
  ( TestTree,
  )
import Test.Tasty.HUnit
  ( testCase,
  )

data CaseAssertion a
  = OK
  | Expected a
  deriving ((forall x. CaseAssertion a -> Rep (CaseAssertion a) x)
-> (forall x. Rep (CaseAssertion a) x -> CaseAssertion a)
-> Generic (CaseAssertion a)
forall x. Rep (CaseAssertion a) x -> CaseAssertion a
forall x. CaseAssertion a -> Rep (CaseAssertion a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CaseAssertion a) x -> CaseAssertion a
forall a x. CaseAssertion a -> Rep (CaseAssertion a) x
$cfrom :: forall a x. CaseAssertion a -> Rep (CaseAssertion a) x
from :: forall x. CaseAssertion a -> Rep (CaseAssertion a) x
$cto :: forall a x. Rep (CaseAssertion a) x -> CaseAssertion a
to :: forall x. Rep (CaseAssertion a) x -> CaseAssertion a
Generic, CaseAssertion a -> CaseAssertion a -> Bool
(CaseAssertion a -> CaseAssertion a -> Bool)
-> (CaseAssertion a -> CaseAssertion a -> Bool)
-> Eq (CaseAssertion a)
forall a. Eq a => CaseAssertion a -> CaseAssertion a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CaseAssertion a -> CaseAssertion a -> Bool
== :: CaseAssertion a -> CaseAssertion a -> Bool
$c/= :: forall a. Eq a => CaseAssertion a -> CaseAssertion a -> Bool
/= :: CaseAssertion a -> CaseAssertion a -> Bool
Eq)

instance FromJSON a => FromJSON (CaseAssertion a) where
  parseJSON :: Value -> Parser (CaseAssertion a)
parseJSON (String Text
"OK") = CaseAssertion a -> Parser (CaseAssertion a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CaseAssertion a
forall a. CaseAssertion a
OK
  parseJSON Value
v = a -> CaseAssertion a
forall a. a -> CaseAssertion a
Expected (a -> CaseAssertion a) -> Parser a -> Parser (CaseAssertion a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON a => ToJSON (CaseAssertion a) where
  toJSON :: CaseAssertion a -> Value
toJSON CaseAssertion a
OK = Text -> Value
String Text
"OK"
  toJSON (Expected a
v) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v

getResponse :: FromJSON a => FileUrl -> IO (CaseAssertion a)
getResponse :: forall a. FromJSON a => FileUrl -> IO (CaseAssertion a)
getResponse = String -> FileUrl -> IO ByteString
forall t. ReadSource t => String -> FileUrl -> IO t
readJSON String
"response" (FileUrl -> IO ByteString)
-> (ByteString -> IO (CaseAssertion a))
-> FileUrl
-> IO (CaseAssertion a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> IO (CaseAssertion a))
-> (CaseAssertion a -> IO (CaseAssertion a))
-> Either String (CaseAssertion a)
-> IO (CaseAssertion a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO (CaseAssertion a)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail CaseAssertion a -> IO (CaseAssertion a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (CaseAssertion a) -> IO (CaseAssertion a))
-> (ByteString -> Either String (CaseAssertion a))
-> ByteString
-> IO (CaseAssertion a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (CaseAssertion a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode

assertResponse ::
  (FromJSON a, Eq a, ToJSON a) =>
  (FileUrl -> IO (CaseAssertion a)) ->
  FileUrl ->
  TestTree
assertResponse :: forall a.
(FromJSON a, Eq a, ToJSON a) =>
(FileUrl -> IO (CaseAssertion a)) -> FileUrl -> TestTree
assertResponse FileUrl -> IO (CaseAssertion a)
f FileUrl
url = String -> Assertion -> TestTree
testCase (FileUrl -> String
fileName FileUrl
url) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
  CaseAssertion a
actual <- FileUrl -> IO (CaseAssertion a)
f FileUrl
url
  CaseAssertion a
expected <- FileUrl -> IO (CaseAssertion a)
forall a. FromJSON a => FileUrl -> IO (CaseAssertion a)
getResponse FileUrl
url
  CaseAssertion a -> CaseAssertion a -> Assertion
forall a. ToJSON a => a -> a -> Assertion
jsonEQ CaseAssertion a
expected CaseAssertion a
actual

runResult :: Result a -> IO a
runResult :: forall a. Result a -> IO a
runResult (Success a
x) = a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
runResult (Error String
x) = String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
x

getQuery :: (FromJSON req) => FileUrl -> IO req
getQuery :: forall req. FromJSON req => FileUrl -> IO req
getQuery FileUrl
url = do
  Value
query <- Text -> Value
String (Text -> Value) -> IO Text -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> FileUrl -> IO Text
forall t. ReadSource t => String -> FileUrl -> IO t
readGQL String
"query" FileUrl
url
  Maybe Value
variables <- ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Value) -> IO ByteString -> IO (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> FileUrl -> IO ByteString
forall t. ReadSource t => String -> FileUrl -> IO t
readJSON String
"variables" FileUrl
url IO (Maybe Value) -> IO (Maybe Value) -> IO (Maybe Value)
forall a. IO a -> IO a -> IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Value -> IO (Maybe Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
  Value -> Maybe Value -> IO req
forall a. FromJSON a => Value -> Maybe Value -> IO a
mkQuery Value
query Maybe Value
variables

mkQuery :: (FromJSON a) => Value -> Maybe Value -> IO a
mkQuery :: forall a. FromJSON a => Value -> Maybe Value -> IO a
mkQuery Value
query Maybe Value
variables =
  Result a -> IO a
forall a. Result a -> IO a
runResult (Result a -> IO a) -> Result a -> IO a
forall a b. (a -> b) -> a -> b
$
    Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result a) -> Value -> Result a
forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
object
        [ Key
"query" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
query,
          Key
"variables" Key -> Maybe Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
variables
        ]

fromEither :: ToJSON err => Either err a -> CaseAssertion err
fromEither :: forall err a. ToJSON err => Either err a -> CaseAssertion err
fromEither (Left err
err) = err -> CaseAssertion err
forall a. a -> CaseAssertion a
Expected err
err
fromEither Right {} = CaseAssertion err
forall a. CaseAssertion a
OK

expects :: ToJSON a => a -> CaseAssertion Value
expects :: forall a. ToJSON a => a -> CaseAssertion Value
expects = Value -> CaseAssertion Value
forall a. a -> CaseAssertion a
Expected (Value -> CaseAssertion Value)
-> (a -> Value) -> a -> CaseAssertion Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON