{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.NoThunks (
  test,
) where

import Cardano.Ledger.Conway.Core (Era (..))
import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses)
import Cardano.Ledger.Shelley.State
import NoThunks.Class (NoThunks)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Generic.GenState (EraGenericGen, GenSize, defaultGenSize)
import Test.Cardano.Ledger.Generic.MockChain (MOCKCHAIN, noThunksGen)
import Test.Cardano.Ledger.Generic.Proof (
  AllegraEra,
  AlonzoEra,
  BabbageEra,
  MaryEra,
  ShelleyEra,
 )
import Test.Cardano.Ledger.Generic.Trace (Gen1, traceProp)
import Test.Cardano.Ledger.Shelley.TreeDiff ()
import Test.Control.State.Transition.Trace.Generator.QuickCheck (HasTrace)

test :: Spec
test :: Spec
test =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"There are no unexpected thunks in MockChainState" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era, NoThunks (StashedAVVMAddresses era)) =>
Spec
f @ShelleyEra
    forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era, NoThunks (StashedAVVMAddresses era)) =>
Spec
f @AllegraEra
    forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era, NoThunks (StashedAVVMAddresses era)) =>
Spec
f @MaryEra
    forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era, NoThunks (StashedAVVMAddresses era)) =>
Spec
f @AlonzoEra
    forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era, NoThunks (StashedAVVMAddresses era)) =>
Spec
f @BabbageEra
  where
    f ::
      forall era.
      ( HasTrace (MOCKCHAIN era) (Gen1 era)
      , EraGenericGen era
      , ShelleyEraAccounts era
      , NoThunks (StashedAVVMAddresses era)
      ) =>
      Spec
    f :: forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era, NoThunks (StashedAVVMAddresses era)) =>
Spec
f = forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 NoThunks (StashedAVVMAddresses era), ShelleyEraAccounts era) =>
Int -> GenSize -> Spec
testThunks @era Int
100 GenSize
defaultGenSize

testThunks ::
  forall era.
  ( HasTrace (MOCKCHAIN era) (Gen1 era)
  , EraGenericGen era
  , NoThunks (StashedAVVMAddresses era)
  , ShelleyEraAccounts era
  ) =>
  Int ->
  GenSize ->
  Spec
testThunks :: forall era.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 NoThunks (StashedAVVMAddresses era), ShelleyEraAccounts era) =>
Int -> GenSize -> Spec
testThunks Int
numTx GenSize
gensize =
  String -> Gen (IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (forall era. Era era => String
eraName @era String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" era. Trace length = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numTx) (Gen (IO ()) -> Spec) -> Gen (IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
    forall era prop.
(HasTrace (MOCKCHAIN era) (Gen1 era), EraGenericGen era,
 ShelleyEraAccounts era) =>
Int
-> GenSize
-> (MockChainState era -> MockChainState era -> prop)
-> Gen prop
traceProp @era
      Int
numTx
      GenSize
gensize
      ( \MockChainState era
_ !MockChainState era
trc -> do
          Maybe ThunkInfo
nt <- MockChainState era -> IO (Maybe ThunkInfo)
forall era.
(EraTxOut era, NoThunks (GovState era), NoThunks (CertState era),
 NoThunks (InstantStake era),
 NoThunks (StashedAVVMAddresses era)) =>
MockChainState era -> IO (Maybe ThunkInfo)
noThunksGen MockChainState era
trc
          case Maybe ThunkInfo
nt of
            Just ThunkInfo
x -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Thunks present: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ThunkInfo -> String
forall a. Show a => a -> String
show ThunkInfo
x
            Maybe ThunkInfo
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      )