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

module Test.Cardano.Ledger.Shelley.JSON (
  roundTripJsonShelleyEraSpec,
) where

import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Transition
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.JSON
import Test.Cardano.Ledger.Shelley.Era

roundTripJsonShelleyEraSpec :: forall era. ShelleyEraTest era => Spec
roundTripJsonShelleyEraSpec :: forall era. ShelleyEraTest era => Spec
roundTripJsonShelleyEraSpec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Shelley era JSON Roundtrip: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> forall era. Era era => String
eraName @era) (Spec -> Spec) -> Spec -> Spec
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 @(TransitionConfig era)