module Servant.QuickCheck.Internal.Equality where
import Data.Aeson (Value, decode, decodeStrict)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.Function (on)
import Network.HTTP.Client (Response (..), equivCookieJar, responseBody)
import Prelude.Compat
newtype ResponseEquality b = ResponseEquality {forall b. ResponseEquality b -> Response b -> Response b -> Bool
getResponseEquality :: Response b -> Response b -> Bool}
instance Semigroup (ResponseEquality b) where
ResponseEquality Response b -> Response b -> Bool
a <> :: ResponseEquality b -> ResponseEquality b -> ResponseEquality b
<> ResponseEquality Response b -> Response b -> Bool
b = (Response b -> Response b -> Bool) -> ResponseEquality b
forall b. (Response b -> Response b -> Bool) -> ResponseEquality b
ResponseEquality ((Response b -> Response b -> Bool) -> ResponseEquality b)
-> (Response b -> Response b -> Bool) -> ResponseEquality b
forall a b. (a -> b) -> a -> b
$ \Response b
x Response b
y ->
Response b -> Response b -> Bool
a Response b
x Response b
y Bool -> Bool -> Bool
&& Response b -> Response b -> Bool
b Response b
x Response b
y
instance Monoid (ResponseEquality b) where
mempty :: ResponseEquality b
mempty = (Response b -> Response b -> Bool) -> ResponseEquality b
forall b. (Response b -> Response b -> Bool) -> ResponseEquality b
ResponseEquality ((Response b -> Response b -> Bool) -> ResponseEquality b)
-> (Response b -> Response b -> Bool) -> ResponseEquality b
forall a b. (a -> b) -> a -> b
$ \Response b
_ Response b
_ -> Bool
True
mappend :: ResponseEquality b -> ResponseEquality b -> ResponseEquality b
mappend = ResponseEquality b -> ResponseEquality b -> ResponseEquality b
forall a. Semigroup a => a -> a -> a
(<>)
allEquality :: (Eq b) => ResponseEquality b
allEquality :: forall b. Eq b => ResponseEquality b
allEquality = (Response b -> Response b -> Bool) -> ResponseEquality b
forall b. (Response b -> Response b -> Bool) -> ResponseEquality b
ResponseEquality ((Response b -> Response b -> Bool) -> ResponseEquality b)
-> (Response b -> Response b -> Bool) -> ResponseEquality b
forall a b. (a -> b) -> a -> b
$ \Response b
respa Response b
respb ->
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ Response b -> Status
forall body. Response body -> Status
responseStatus Response b
respa Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Response b -> Status
forall body. Response body -> Status
responseStatus Response b
respb
, Response b -> HttpVersion
forall body. Response body -> HttpVersion
responseVersion Response b
respa HttpVersion -> HttpVersion -> Bool
forall a. Eq a => a -> a -> Bool
== Response b -> HttpVersion
forall body. Response body -> HttpVersion
responseVersion Response b
respb
, Response b -> ResponseHeaders
forall body. Response body -> ResponseHeaders
responseHeaders Response b
respa ResponseHeaders -> ResponseHeaders -> Bool
forall a. Eq a => a -> a -> Bool
== Response b -> ResponseHeaders
forall body. Response body -> ResponseHeaders
responseHeaders Response b
respb
, Response b -> b
forall body. Response body -> body
responseBody Response b
respa b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Response b -> b
forall body. Response body -> body
responseBody Response b
respb
, Response b -> CookieJar
forall body. Response body -> CookieJar
responseCookieJar Response b
respa CookieJar -> CookieJar -> Bool
`equivCookieJar` Response b -> CookieJar
forall body. Response body -> CookieJar
responseCookieJar Response b
respb
]
bodyEquality :: (Eq b) => ResponseEquality b
bodyEquality :: forall b. Eq b => ResponseEquality b
bodyEquality = (Response b -> Response b -> Bool) -> ResponseEquality b
forall b. (Response b -> Response b -> Bool) -> ResponseEquality b
ResponseEquality (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool)
-> (Response b -> b) -> Response b -> Response b -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Response b -> b
forall body. Response body -> body
responseBody)
jsonEquality :: (JsonEq b) => ResponseEquality b
jsonEquality :: forall b. JsonEq b => ResponseEquality b
jsonEquality = (Response b -> Response b -> Bool) -> ResponseEquality b
forall b. (Response b -> Response b -> Bool) -> ResponseEquality b
ResponseEquality (b -> b -> Bool
forall a. JsonEq a => a -> a -> Bool
jsonEq (b -> b -> Bool)
-> (Response b -> b) -> Response b -> Response b -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Response b -> b
forall body. Response body -> body
responseBody)
class JsonEq a where
decode' :: a -> Maybe Value
jsonEq :: a -> a -> Bool
jsonEq a
first a
second = Maybe Value -> Maybe Value -> Bool
compareDecodedResponses (a -> Maybe Value
forall a. JsonEq a => a -> Maybe Value
decode' a
first) (a -> Maybe Value
forall a. JsonEq a => a -> Maybe Value
decode' a
second)
instance JsonEq LB.ByteString where
decode' :: ByteString -> Maybe Value
decode' = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode
instance JsonEq ByteString where
decode' :: ByteString -> Maybe Value
decode' = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict
compareDecodedResponses :: Maybe Value -> Maybe Value -> Bool
compareDecodedResponses :: Maybe Value -> Maybe Value -> Bool
compareDecodedResponses Maybe Value
resp1 Maybe Value
resp2 =
case Maybe Value
resp1 of
Maybe Value
Nothing -> Bool
False
(Just Value
r1) -> case Maybe Value
resp2 of
Maybe Value
Nothing -> Bool
False
(Just Value
r2) -> Value
r1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
r2