Move criterion dependency to bench and remove ghc-prim dependency

Remove tasty dependency

re-organize cabal file to make it possible to build tests inline

get rid of RoseTree type in favour of Data.Tree

simplfy benchmarks dependencies to avoid building the tests twice and
avoid weird dependencies

hie.yaml

@@ -255,6 +255,9 @@ cradle:
     - path: "libs/constrained-generators/bench/Main.hs"
       component: "constrained-generators:bench:bench"
 
+    - path: "libs/constrained-generators/bench/Constrained/Bench.hs"
+      component: "constrained-generators:bench:bench"
+
     - path: "libs/ledger-state/src"
       component: "lib:ledger-state"
 

libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/ExecSpecRule/Core.hs

@@ -19,7 +19,7 @@ module Test.Cardano.Ledger.Conformance.ExecSpecRule.Core (
 import Cardano.Ledger.BaseTypes (Inject, ShelleyBase)
 import Cardano.Ledger.Core (EraRule)
 import qualified Constrained as CV2
-import Constrained.Base (Spec (..))
+import Constrained.Base (Specification (..))
 import Control.State.Transition.Extended (STS (..))
 import Data.Bifunctor (Bifunctor (..))
 import Data.Bitraversable (bimapM)
@@ -73,21 +73,21 @@ class
   type ExecContext fn rule era = ()
 
   environmentSpec ::
-    CV2.Spec fn (Environment (EraRule rule era))
+    CV2.Specification fn (Environment (EraRule rule era))
 
   stateSpec ::
     Environment (EraRule rule era) ->
-    CV2.Spec fn (State (EraRule rule era))
+    CV2.Specification fn (State (EraRule rule era))
 
   signalSpec ::
     Environment (EraRule rule era) ->
     State (EraRule rule era) ->
-    CV2.Spec fn (Signal (EraRule rule era))
+    CV2.Specification fn (Signal (EraRule rule era))
 
-  execContextSpec :: CV2.Spec fn (ExecContext fn rule era)
+  execContextSpec :: CV2.Specification fn (ExecContext fn rule era)
   default execContextSpec ::
     ExecContext fn rule era ~ () =>
-    CV2.Spec fn (ExecContext fn rule era)
+    CV2.Specification fn (ExecContext fn rule era)
   execContextSpec = TrueSpec
 
   runAgdaRule ::

libs/cardano-ledger-test/bench/Bench/Constrained/STS.hs

@@ -12,14 +12,14 @@ import Cardano.Ledger.Conway
 import Cardano.Ledger.Conway.Rules
 import Cardano.Ledger.Crypto
 import Constrained
-import Constrained.Bench
+import Control.DeepSeq
 import Criterion
 import Test.Cardano.Ledger.Constrained.Conway
 
 govEnv :: GovEnv (ConwayEra StandardCrypto)
 govEnv = genFromSpecWithSeed 10 30 (govEnvSpec @ConwayFn)
 
-singleProposalTreeSpec :: Spec ConwayFn ProposalTree
+singleProposalTreeSpec :: Specification ConwayFn ProposalTree
 singleProposalTreeSpec = constrained $ \ppupTree ->
   [ wellFormedChildren (lit SNothing) ppupTree
   , allGASInTree ppupTree $ \gas ->
@@ -38,3 +38,8 @@ stsBenchmarks =
     ]
   where
     govPropSpec = govProposalsSpec @ConwayFn govEnv
+
+benchSpec :: (HasSpec fn a, NFData a) => Int -> Int -> String -> Specification fn a -> Benchmark
+benchSpec seed size nm spec =
+  bench (unlines [nm, show (genFromSpecWithSeed seed size spec)]) $
+    nf (genFromSpecWithSeed seed size) spec

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Cert.hs

@@ -22,15 +22,15 @@ import Test.Cardano.Ledger.Constrained.Conway.Pool
 
 certEnvSpec ::
   IsConwayUniv fn =>
-  Spec fn (CertEnv (ConwayEra StandardCrypto))
+  Specification fn (CertEnv (ConwayEra StandardCrypto))
 certEnvSpec =
   constrained $ \ce ->
     match ce $ \_ pp _ ->
       satisfies pp pparamsSpec
 
 certStateSpec ::
   IsConwayUniv fn =>
-  Spec fn (CertState (ConwayEra StandardCrypto))
+  Specification fn (CertState (ConwayEra StandardCrypto))
 certStateSpec =
   constrained $ \cs ->
     match cs $ \vState pState dState ->
@@ -43,7 +43,7 @@ txCertSpec ::
   IsConwayUniv fn =>
   CertEnv (ConwayEra StandardCrypto) ->
   CertState (ConwayEra StandardCrypto) ->
-  Spec fn (ConwayTxCert (ConwayEra StandardCrypto))
+  Specification fn (ConwayTxCert (ConwayEra StandardCrypto))
 txCertSpec (CertEnv slot pp ce) CertState {..} =
   constrained $ \txCert ->
     caseOn

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Deleg.hs

@@ -21,7 +21,7 @@ import Test.Cardano.Ledger.Constrained.Conway.Instances
 
 dStateSpec ::
   IsConwayUniv fn =>
-  Spec fn (DState (ConwayEra StandardCrypto))
+  Specification fn (DState (ConwayEra StandardCrypto))
 dStateSpec = constrained $ \ds ->
   match ds $ \rewardMap _futureGenDelegs _genDelegs _rewards ->
     match rewardMap $ \rdMap ptrMap sPoolMap _dRepMap ->
@@ -33,7 +33,7 @@ delegCertSpec ::
   IsConwayUniv fn =>
   PParams (ConwayEra StandardCrypto) ->
   DState (ConwayEra StandardCrypto) ->
-  Spec fn (ConwayDelegCert StandardCrypto)
+  Specification fn (ConwayDelegCert StandardCrypto)
 delegCertSpec pp ds =
   let rewardMap = unUnify $ rewards ds
       delegMap = unUnify $ delegations ds

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs

@@ -31,7 +31,7 @@ import Test.Cardano.Ledger.Constrained.Conway.PParams
 
 govEnvSpec ::
   IsConwayUniv fn =>
-  Spec fn (GovEnv (ConwayEra StandardCrypto))
+  Specification fn (GovEnv (ConwayEra StandardCrypto))
 govEnvSpec = constrained $ \ge ->
   match ge $ \_ _ pp _ _ _ ->
     satisfies pp pparamsSpec
@@ -42,7 +42,7 @@ govEnvSpec = constrained $ \ge ->
 govProposalsSpec ::
   IsConwayUniv fn =>
   GovEnv (ConwayEra StandardCrypto) ->
-  Spec fn (Proposals (ConwayEra StandardCrypto))
+  Specification fn (Proposals (ConwayEra StandardCrypto))
 govProposalsSpec GovEnv {geEpoch, gePPolicy, gePrevGovActionIds} =
   constrained $ \props ->
     match props $ \ppupTree hardForkTree committeeTree constitutionTree unorderedProposals ->
@@ -154,7 +154,7 @@ allGASAndChildInTree t k =
   forAll (snd_ t) $ \t' ->
     forAll' t' $ \gas cs ->
       forAll cs $ \t'' ->
-        k gas (roseRoot_ t'')
+        k gas (rootLabel_ t'')
 
 wellFormedChildren ::
   IsConwayUniv fn =>
@@ -166,11 +166,11 @@ wellFormedChildren root rootAndTrees =
     [ assert $ root ==. root' -- The root matches the root given in the environment
     , forAll trees $ \t ->
         [ -- Every node just below the root has the root as its parent
-          withPrevActId (roseRoot_ t) (assert . (==. root))
+          withPrevActId (rootLabel_ t) (assert . (==. root))
         , -- Every node's children have the id of the node as its parent
           forAll' t $ \gas children ->
             [ forAll children $ \t' ->
-                [ withPrevActId (roseRoot_ t') (assert . (==. cSJust_ (gasId_ gas)))
+                [ withPrevActId (rootLabel_ t') (assert . (==. cSJust_ (gasId_ gas)))
                 -- TODO: figure out why this causes a crash!
                 -- , t' `dependsOn` gas
                 ]
@@ -245,7 +245,7 @@ govProceduresSpec ::
   IsConwayUniv fn =>
   GovEnv (ConwayEra StandardCrypto) ->
   Proposals (ConwayEra StandardCrypto) ->
-  Spec fn (GovProcedures (ConwayEra StandardCrypto))
+  Specification fn (GovProcedures (ConwayEra StandardCrypto))
 govProceduresSpec ge@GovEnv {..} ps =
   let actions f =
         [ gid

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/GovCert.hs

@@ -19,14 +19,14 @@ import Cardano.Ledger.Crypto (StandardCrypto)
 import Test.Cardano.Ledger.Constrained.Conway.Instances
 import Test.Cardano.Ledger.Constrained.Conway.PParams
 
-vStateSpec :: Spec fn (VState (ConwayEra StandardCrypto))
+vStateSpec :: Specification fn (VState (ConwayEra StandardCrypto))
 vStateSpec = TrueSpec
 
 govCertSpec ::
   IsConwayUniv fn =>
   ConwayGovCertEnv (ConwayEra StandardCrypto) ->
   VState (ConwayEra StandardCrypto) ->
-  Spec fn (ConwayGovCert StandardCrypto)
+  Specification fn (ConwayGovCert StandardCrypto)
 govCertSpec ConwayGovCertEnv {..} vs =
   let reps = lit $ Map.keysSet $ vsDReps vs
       deposits = lit [(k, drepDeposit dep) | (k, dep) <- Map.toList $ vsDReps vs]
@@ -54,7 +54,7 @@ govCertSpec ConwayGovCertEnv {..} vs =
 
 govCertEnvSpec ::
   IsConwayUniv fn =>
-  Spec fn (ConwayGovCertEnv (ConwayEra StandardCrypto))
+  Specification fn (ConwayGovCertEnv (ConwayEra StandardCrypto))
 govCertEnvSpec =
   constrained $ \gce ->
     match gce $ \pp _ ->

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances.hs

@@ -62,6 +62,7 @@ import Cardano.Ledger.Allegra.Scripts
 import Cardano.Ledger.Alonzo.PParams
 import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
 import Cardano.Ledger.Alonzo.Tx
+import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), AuxiliaryDataHash)
 import Cardano.Ledger.Alonzo.TxOut
 import Cardano.Ledger.Alonzo.TxWits
 import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
@@ -70,6 +71,7 @@ import Cardano.Ledger.Binary (Sized (..))
 import Cardano.Ledger.CertState
 import Cardano.Ledger.Coin
 import Cardano.Ledger.Compactible
+import Cardano.Ledger.Conway (ConwayEra)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Conway.PParams
@@ -78,6 +80,7 @@ import Cardano.Ledger.Conway.Scripts ()
 import Cardano.Ledger.Conway.TxBody
 import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Credential
+import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
 import Cardano.Ledger.EpochBoundary
 import Cardano.Ledger.HKD
 import Cardano.Ledger.Keys (
@@ -100,10 +103,13 @@ import Cardano.Ledger.SafeHash
 import Cardano.Ledger.Shelley.LedgerState hiding (ptrMap)
 import Cardano.Ledger.Shelley.PoolRank
 import Cardano.Ledger.Shelley.Rules
+import Cardano.Ledger.Shelley.TxAuxData (Metadatum)
 import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
 import Cardano.Ledger.UMap
 import Cardano.Ledger.UTxO
 import Cardano.Ledger.Val (Val)
+import Constrained hiding (Value)
+import Constrained qualified as C
 import Control.Monad.Trans.Fail.String
 import Crypto.Hash (Blake2b_224)
 import Data.ByteString qualified as BS
@@ -137,22 +143,15 @@ import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Core.Utils
 import Test.QuickCheck hiding (Args, Fun, forAll)
 
-import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), AuxiliaryDataHash)
-import Cardano.Ledger.Conway (ConwayEra)
-import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
-import Cardano.Ledger.Shelley.TxAuxData (Metadatum)
-import Constrained hiding (Value)
-import Constrained qualified as C
-
-type ConwayUnivFns = StringFn : RoseTreeFn : BaseFns
+type ConwayUnivFns = StringFn : TreeFn : BaseFns
 type ConwayFn = Fix (OneofL ConwayUnivFns)
 
 type IsConwayUniv fn =
   ( BaseUniverse fn
   , Member (StringFn fn) fn
   , Member (MapFn fn) fn
   , Member (FunFn fn) fn
-  , Member (RoseTreeFn fn) fn
+  , Member (TreeFn fn) fn
   )
 
 -- TxBody HasSpec instance ------------------------------------------------
@@ -399,7 +398,7 @@ However, when you do that some questions arise:
 Sum and Prod things (with some global index of sizes: `TypeRep -> Int`). Potentially
 you could solve this by having size constraints in the language. There the question is
 how you design those constraints - their semantics could be `const True` while still
-changing the `Spec` - thus giving you the ability to provide a generation time hint!
+changing the `Specification` - thus giving you the ability to provide a generation time hint!
 
 Solving (1) is more tricky however. The best guess I have is that you would need
 to push any constraint you have into functions `MyConstraint :: MyUniv fn '[Timelock era] Bool`
@@ -599,7 +598,7 @@ instance IsConwayUniv fn => HasSpec fn Text where
   conformsTo _ _ = True
   toPreds _ _ = toPred True
 
-data StringSpec fn = StringSpec {strSpecLen :: Spec fn Int}
+data StringSpec fn = StringSpec {strSpecLen :: Specification fn Int}
 
 deriving instance IsConwayUniv fn => Show (StringSpec fn)
 
@@ -682,8 +681,8 @@ instance IsConwayUniv fn => Functions (StringFn fn) fn where
       (_ :: StringFn fn '[s] Int) -> getLengthSpec @s ss
 
 class StringLike s where
-  lengthSpec :: IsConwayUniv fn => Spec fn Int -> TypeSpec fn s
-  getLengthSpec :: TypeSpec fn s -> Spec fn Int
+  lengthSpec :: IsConwayUniv fn => Specification fn Int -> TypeSpec fn s
+  getLengthSpec :: TypeSpec fn s -> Specification fn Int
   getLength :: s -> Int
 
 instance HasSimpleRep (Delegatee c)
@@ -1020,7 +1019,7 @@ gasProposalProcedure_ ::
 gasProposalProcedure_ = sel @4
 
 type GAS = GovActionState (ConwayEra StandardCrypto)
-type ProposalTree = (StrictMaybe (GovActionId StandardCrypto), [RoseTree GAS])
+type ProposalTree = (StrictMaybe (GovActionId StandardCrypto), [Tree GAS])
 type ProposalsType =
   '[ ProposalTree -- PParamUpdate
    , ProposalTree -- HardFork
@@ -1059,8 +1058,8 @@ instance HasSimpleRep (Proposals (ConwayEra StandardCrypto)) where
       buildProposalTree :: TreeMaybe (GovActionId StandardCrypto) -> ProposalTree
       buildProposalTree (TreeMaybe (Node mId cs)) = (mId, map buildTree cs)
 
-      buildTree :: Tree (StrictMaybe (GovActionId StandardCrypto)) -> RoseTree GAS
-      buildTree (Node (SJust gid) cs) | Just gas <- Map.lookup gid idMap = RoseNode gas (map buildTree cs)
+      buildTree :: Tree (StrictMaybe (GovActionId StandardCrypto)) -> Tree GAS
+      buildTree (Node (SJust gid) cs) | Just gas <- Map.lookup gid idMap = Node gas (map buildTree cs)
       buildTree _ =
         error "toSimpleRep @Proposals: toGovRelationTree returned trees with Nothing nodes below the root"
 
@@ -1077,7 +1076,7 @@ instance HasSimpleRep (Proposals (ConwayEra StandardCrypto)) where
             oMap = foldMap (foldMap mkOMap) [ppupTree, hfTree, comTree, conTree] <> OMap.fromFoldable others
          in unsafeMkProposals root oMap
     where
-      mkOMap (RoseNode a ts) = a OMap.<| foldMap mkOMap ts
+      mkOMap (Node a ts) = a OMap.<| foldMap mkOMap ts
 
 instance IsConwayUniv fn => HasSpec fn (Proposals (ConwayEra StandardCrypto))
 

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Ledger.hs

@@ -19,7 +19,7 @@ ledgerTxSpec ::
   IsConwayUniv fn =>
   LedgerEnv (ConwayEra StandardCrypto) ->
   LedgerState (ConwayEra StandardCrypto) ->
-  Spec fn (Tx (ConwayEra StandardCrypto))
+  Specification fn (Tx (ConwayEra StandardCrypto))
 ledgerTxSpec env st =
   constrained $ \tx ->
     [ satisfies tx (utxoTxSpec utxoEnv (lsUTxOState st))

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/PParams.hs

@@ -13,7 +13,7 @@ import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Crypto (StandardCrypto)
 import Test.Cardano.Ledger.Constrained.Conway.Instances (IsConwayUniv)
 
-pparamsSpec :: IsConwayUniv fn => Spec fn (PParams (ConwayEra StandardCrypto))
+pparamsSpec :: IsConwayUniv fn => Specification fn (PParams (ConwayEra StandardCrypto))
 pparamsSpec =
   constrained $ \pp ->
     match pp $ \cpp ->

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Pool.hs

@@ -31,15 +31,15 @@ currentEpoch = runIdentity . EI.epochInfoEpoch (epochInfoPure testGlobals)
 
 poolEnvSpec ::
   IsConwayUniv fn =>
-  Spec fn (PoolEnv (ConwayEra StandardCrypto))
+  Specification fn (PoolEnv (ConwayEra StandardCrypto))
 poolEnvSpec =
   constrained $ \pe ->
     match pe $ \_ pp ->
       satisfies pp pparamsSpec
 
 pStateSpec ::
   IsConwayUniv fn =>
-  Spec fn (PState (ConwayEra StandardCrypto))
+  Specification fn (PState (ConwayEra StandardCrypto))
 pStateSpec = constrained $ \ps ->
   match ps $ \stakePoolParams futureStakePoolParams retiring deposits ->
     [ assertExplain ["dom of retiring is a subset of dom of stakePoolParams"] $
@@ -57,7 +57,7 @@ poolCertSpec ::
   IsConwayUniv fn =>
   PoolEnv (ConwayEra StandardCrypto) ->
   PState (ConwayEra StandardCrypto) ->
-  Spec fn (PoolCert StandardCrypto)
+  Specification fn (PoolCert StandardCrypto)
 poolCertSpec (PoolEnv s pp) ps =
   constrained $ \pc ->
     (caseOn pc)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Utxo.hs

@@ -29,7 +29,7 @@ import Cardano.Ledger.Crypto (StandardCrypto)
 import Test.Cardano.Ledger.Constrained.Conway.Instances
 import Test.Cardano.Ledger.Constrained.Conway.PParams
 
-utxoEnvSpec :: IsConwayUniv fn => Spec fn (UtxoEnv (ConwayEra StandardCrypto))
+utxoEnvSpec :: IsConwayUniv fn => Specification fn (UtxoEnv (ConwayEra StandardCrypto))
 utxoEnvSpec =
   constrained $ \utxoEnv ->
     match utxoEnv $
@@ -79,7 +79,7 @@ utxoEnvSpec =
 utxoStateSpec ::
   IsConwayUniv fn =>
   UtxoEnv (ConwayEra StandardCrypto) ->
-  Spec fn (UTxOState (ConwayEra StandardCrypto))
+  Specification fn (UTxOState (ConwayEra StandardCrypto))
 utxoStateSpec _env =
   constrained $ \utxoState ->
     match utxoState $
@@ -98,7 +98,7 @@ utxoTxSpec ::
   IsConwayUniv fn =>
   UtxoEnv (ConwayEra StandardCrypto) ->
   UTxOState (ConwayEra StandardCrypto) ->
-  Spec fn (Tx (ConwayEra StandardCrypto))
+  Specification fn (Tx (ConwayEra StandardCrypto))
 utxoTxSpec env st =
   constrained $ \tx ->
     match tx $ \bdy _wits isValid _auxData ->