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 {getResponseEquality :: Response b -> Response b -> Bool}

instance Semigroup (ResponseEquality b) where
  ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->
    a x y && b x y

instance Monoid (ResponseEquality b) where
  mempty = ResponseEquality $ \_ _ -> True
  mappend = (<>)

-- | Use `Eq` instance for `Response`
--
-- /Since 0.0.0.0/
allEquality :: Eq b => ResponseEquality b
allEquality = ResponseEquality $ \respa respb ->
  and
    [ responseStatus respa == responseStatus respb
    , responseVersion respa == responseVersion respb
    , responseHeaders respa == responseHeaders respb
    , responseBody respa == responseBody respb
    , responseCookieJar respa `equivCookieJar` responseCookieJar respb
    ]

-- | ByteString `Eq` instance over the response body.
--
-- /Since 0.0.0.0/
bodyEquality :: Eq b => ResponseEquality b
bodyEquality = ResponseEquality ((==) `on` responseBody)

-- | Equality as 'Value'. This means that if two bodies are equal as JSON
-- (e.g., insignificant whitespace difference) they are considered equal.
--
-- /Since 0.0.3.0/
jsonEquality :: JsonEq b => ResponseEquality b
jsonEquality = ResponseEquality (jsonEq `on` responseBody)

class JsonEq a where
  decode' :: a -> Maybe Value
  jsonEq :: a -> a -> Bool
  jsonEq first second = compareDecodedResponses (decode' first) (decode' second)

instance JsonEq LB.ByteString where
  decode' = decode

instance JsonEq ByteString where
  decode' = decodeStrict

compareDecodedResponses :: Maybe Value -> Maybe Value -> Bool
compareDecodedResponses resp1 resp2 =
  case resp1 of
    Nothing -> False -- if decoding fails we assume failure
    (Just r1) -> case resp2 of
      Nothing -> False -- another decode failure
      (Just r2) -> r1 == r2
