{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Data.JSON.Utils (
  roundTripJsonSpec,
  roundTripJsonProperty,
) where

import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.Function ((&))
import Data.Proxy (Proxy (Proxy))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable (Typeable, typeRep)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck (Arbitrary, Property, counterexample, property)

-- | QuickCheck property spec that uses `roundTripJsonProperty`
roundTripJsonSpec ::
  forall t.
  (HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t, Arbitrary t) =>
  Spec
roundTripJsonSpec :: forall t.
(HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t,
 Arbitrary t) =>
Spec
roundTripJsonSpec =
  String -> (t -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> TypeRep) -> Proxy t -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t)) ((t -> Property) -> Spec) -> (t -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall t.
(HasCallStack, Show t, Eq t, ToJSON t, FromJSON t) =>
t -> Property
roundTripJsonProperty @t

-- | Roundtrip JSON testing for types that implement ToJSON/FromJSON.
roundTripJsonProperty ::
  forall t.
  (HasCallStack, Show t, Eq t, ToJSON t, FromJSON t) =>
  t ->
  Property
roundTripJsonProperty :: forall t.
(HasCallStack, Show t, Eq t, ToJSON t, FromJSON t) =>
t -> Property
roundTripJsonProperty t
original = do
  let encoded :: ByteString
encoded = t -> ByteString
forall a. ToJSON a => a -> ByteString
encode t
original
      encodedString :: String
encodedString =
        String
"Encoded: \n  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BSL.toStrict ByteString
encoded))
  case ByteString -> Either String t
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
encoded of
    Left String
err ->
      Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
        Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Failed decoding: \n  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
encodedString)
    Right t
result ->
      Expectation -> Property
forall prop. Testable prop => prop -> Property
property (t
result t -> t -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` t
original)
        Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
encodedString