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, responseBody)
import Data.Semigroup      (Semigroup (..))
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 (==)

-- | 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