Undid ImpredicativeTypes because of GHC8

IntersectMBO · Dec 6, 2024 · c4bb012 · c4bb012
1 parent 973d67b
commit c4bb012
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 29 deletions.
diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
@@ -633,15 +632,14 @@ modifyImpInitProtVer ver =
 
 modifyImpInitExpectLedgerRuleConformance ::
   forall era.
-  ( forall t.
-    Globals ->
+  ( Globals ->
     Either
       (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
       (State (EraRule "LEDGER" era), [Event (EraRule "LEDGER" era)]) ->
     LedgerEnv era ->
     LedgerState era ->
     Tx era ->
-    ImpM t ()
+    Expectation
   ) ->
   SpecWith (ImpInit (LedgerSpec era)) ->
   SpecWith (ImpInit (LedgerSpec era))
@@ -794,15 +792,14 @@ impWitsVKeyNeeded txBody = do
 data ImpTestEnv era = ImpTestEnv
   { iteFixup :: Tx era -> ImpTestM era (Tx era)
   , iteExpectLedgerRuleConformance ::
-      forall t.
       Globals ->
       Either
         (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
         (State (EraRule "LEDGER" era), [Event (EraRule "LEDGER" era)]) ->
       LedgerEnv era ->
       LedgerState era ->
       Tx era ->
-      ImpM t ()
+      Expectation
   -- ^ Note the use of higher ranked types here. This prevents the hook from
   -- accessing the state while still permitting the use of more general
   -- functions that return some `ImpM t a` and that don't constrain the
@@ -818,15 +815,14 @@ iteExpectLedgerRuleConformanceL ::
   forall era.
   Lens'
     (ImpTestEnv era)
-    ( forall t.
-      Globals ->
+    ( Globals ->
       Either
         (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
         (State (EraRule "LEDGER" era), [Event (EraRule "LEDGER" era)]) ->
       LedgerEnv era ->
       LedgerState era ->
       Tx era ->
-      ImpM t ()
+      Expectation
     )
 iteExpectLedgerRuleConformanceL = lens iteExpectLedgerRuleConformance (\x y -> x {iteExpectLedgerRuleConformance = y})
 
@@ -1092,7 +1088,7 @@ trySubmitTx tx = do
 
   -- Check for conformance
   asks iteExpectLedgerRuleConformance
-    >>= (\f -> f globals res lEnv (st ^. nesEsL . esLStateL) txFixed)
+    >>= (\f -> liftIO $ f globals res lEnv (st ^. nesEsL . esLStateL) txFixed)
 
   case res of
     Left predFailures -> do

diff --git a/libs/cardano-ledger-conformance/test/Test/Cardano/Ledger/Conformance/Imp.hs b/libs/cardano-ledger-conformance/test/Test/Cardano/Ledger/Conformance/Imp.hs
@@ -35,7 +35,7 @@ import Test.Cardano.Ledger.Imp.Common hiding (Args)
 import UnliftIO (evaluateDeep)
 
 testImpConformance ::
-  forall era t.
+  forall era.
   ( ConwayEraImp era
   , ExecSpecRule ConwayFn "LEDGER" era
   , ExecContext ConwayFn "LEDGER" era ~ ConwayLedgerExecContext era
@@ -53,7 +53,6 @@ testImpConformance ::
   , ExecEnvironment ConwayFn "LEDGER" era ~ LedgerEnv era
   , Tx era ~ AlonzoTx era
   , SpecTranslate (ConwayTxBodyTransContext (EraCrypto era)) (TxBody era)
-  , ToExpr (SpecRep (PredicateFailure (EraRule "LEDGER" era)))
   ) =>
   Globals ->
   Either
@@ -62,8 +61,8 @@ testImpConformance ::
   ExecEnvironment ConwayFn "LEDGER" era ->
   ExecState ConwayFn "LEDGER" era ->
   ExecSignal ConwayFn "LEDGER" era ->
-  ImpM t ()
-testImpConformance globals impRuleResult env state signal = impAnn "`submitTx` conformance" $ do
+  Expectation
+testImpConformance _ impRuleResult env state signal = do
   let ctx =
         ConwayLedgerExecContext
           { clecPolicyHash =
@@ -101,22 +100,7 @@ testImpConformance globals impRuleResult env state signal = impAnn "`submitTx` c
           (toTestRep . inject @_ @(ExecState ConwayFn "LEDGER" era) . fst)
           impRuleResult
 
-  logString "implEnv"
-  logToExpr env
-  logString "implState"
-  logToExpr state
-  logString "implSignal"
-  logToExpr signal
-  logString "specEnv"
-  logToExpr specEnv
-  logString "specState"
-  logToExpr specState
-  logString "specSignal"
-  logToExpr specSignal
-  logString "Extra info:"
-  logDoc $ extraInfo @ConwayFn @"LEDGER" @era globals ctx env state signal impRuleResult
   when (impResponse /= agdaResponse) $ do
-    logDoc $ diffConformance impResponse agdaResponse
     assertFailure "Conformance failure"
 
 spec :: Spec