{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Core.JSON (
  roundTripJsonSpec,
  roundTripJsonEraSpec,
  roundTripJsonProperty,
) where

import Cardano.Ledger.Core
import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as BSL
import Data.Function ((&))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable (Proxy (..), Typeable, typeRep)
import GHC.Stack
import Test.Cardano.Ledger.Common

-- | 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 =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @t)) 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 = forall a. ToJSON a => a -> ByteString
encode t
original
      encodedString :: String
encodedString =
        String
"Encoded: \n  " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BSL.toStrict (forall a. ToJSON a => a -> ByteString
encodePretty t
original)))
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
encoded of
    Left String
err ->
      forall prop. Testable prop => prop -> Property
property Bool
False
        forall a b. a -> (a -> b) -> b
& forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Failed decoding: \n  " forall a. Semigroup a => a -> a -> a
<> String
err forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
encodedString)
    Right t
result ->
      forall prop. Testable prop => prop -> Property
property (t
result forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` t
original)
        forall a b. a -> (a -> b) -> b
& forall prop. Testable prop => String -> prop -> Property
counterexample String
encodedString

-- | Roundtrip JSON testing for core type families.
roundTripJsonEraSpec ::
  forall era.
  ( HasCallStack
  , EraPParams era
  , Arbitrary (PParams era)
  ) =>
  Spec
roundTripJsonEraSpec :: forall era.
(HasCallStack, EraPParams era, Arbitrary (PParams era)) =>
Spec
roundTripJsonEraSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall era. Era era => String
eraName @era) forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip JSON" forall a b. (a -> b) -> a -> b
$ do
      forall t.
(HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t,
 Arbitrary t) =>
Spec
roundTripJsonSpec @(PParams era)