{-# 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,
    encode,
    fromJSON,
    object,
    (.=),
  )
import Relude hiding (ByteString)
import Test.Morpheus.File (FileUrl (fileName), readGQL, readJSON)
import Test.Morpheus.Utils (requireEq)
import Test.Tasty
  ( TestTree,
  )
import Test.Tasty.HUnit
  ( testCase,
  )

data CaseAssertion a
  = OK
  | Expected a
  deriving (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
$cto :: forall a x. Rep (CaseAssertion a) x -> CaseAssertion a
$cfrom :: forall a x. CaseAssertion a -> Rep (CaseAssertion a) x
Generic, CaseAssertion a -> CaseAssertion a -> Bool
forall a. Eq a => CaseAssertion a -> CaseAssertion a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseAssertion a -> CaseAssertion a -> Bool
$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
Eq)

instance FromJSON a => FromJSON (CaseAssertion a) where
  parseJSON :: Value -> Parser (CaseAssertion a)
parseJSON (String Text
"OK") = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. CaseAssertion a
OK
  parseJSON Value
v = forall a. a -> CaseAssertion a
Expected forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = 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 = forall t. ReadSource t => String -> FileUrl -> IO t
readJSON String
"response" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a b. (a -> b) -> a -> b
$ do
  CaseAssertion a
actual <- FileUrl -> IO (CaseAssertion a)
f FileUrl
url
  CaseAssertion a
expected <- forall a. FromJSON a => FileUrl -> IO (CaseAssertion a)
getResponse FileUrl
url
  forall t. Eq t => (t -> ByteString) -> t -> t -> Assertion
requireEq forall a. ToJSON a => a -> ByteString
encode CaseAssertion a
expected CaseAssertion a
actual

runResult :: Result a -> IO a
runResult :: forall a. Result a -> IO a
runResult (Success a
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
runResult (Error String
x) = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. ReadSource t => String -> FileUrl -> IO t
readGQL String
"query" FileUrl
url
  Maybe Value
variables <- forall a. FromJSON a => ByteString -> Maybe a
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. ReadSource t => String -> FileUrl -> IO t
readJSON String
"variables" FileUrl
url forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  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 =
  forall a. Result a -> IO a
runResult forall a b. (a -> b) -> a -> b
$
    forall a. FromJSON a => Value -> Result a
fromJSON forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
object
        [ Key
"query" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
query,
          Key
"variables" forall kv v. (KeyValue 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) = forall a. a -> CaseAssertion a
Expected err
err
fromEither Right {} = forall a. CaseAssertion a
OK

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