Revert "Undid ImpredicativeTypes because of GHC8"

This reverts commit d99e0cd.

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs

@@ -1,11 +1,13 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
@@ -22,6 +24,7 @@
 
 module Test.Cardano.Ledger.Shelley.ImpTest (
   ImpTestM,
+  BaseImpM,
   LedgerSpec,
   SomeSTSEvent (..),
   ImpTestState,
@@ -289,6 +292,20 @@ import UnliftIO (evaluateDeep)
 
 type ImpTestM era = ImpM (LedgerSpec era)
 
+-- TODO remove this once we get rid of the CPP directives
+{- FOURMOLU_DISABLE -}
+type BaseImpM a = -- TODO get rid of the CPP once we have deprecated GHC8
+#if __GLASGOW_HASKELL__ < 906
+  Expectation
+#else
+  forall t. ImpM t a
+  -- ^ 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
+  -- state in any way (e.g. `logString`, `shouldBe` are still fine to use).
+#endif
+{- FOURMOLU_ENABLE -}
+
 data LedgerSpec era
 
 instance ShelleyEraImp era => ImpSpec (LedgerSpec era) where
@@ -640,7 +657,7 @@ modifyImpInitExpectLedgerRuleConformance ::
     LedgerEnv era ->
     LedgerState era ->
     Tx era ->
-    Expectation
+    BaseImpM ()
   ) ->
   SpecWith (ImpInit (LedgerSpec era)) ->
   SpecWith (ImpInit (LedgerSpec era))
@@ -800,11 +817,7 @@ data ImpTestEnv era = ImpTestEnv
       LedgerEnv era ->
       LedgerState era ->
       Tx era ->
-      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
-  -- state in any way (e.g. `logString`, `shouldBe` are still fine to use).
+      BaseImpM ()
   , iteCborRoundTripFailures :: !Bool
   -- ^ Expect failures in CBOR round trip serialization tests for predicate failures
   }
@@ -823,7 +836,7 @@ iteExpectLedgerRuleConformanceL ::
       LedgerEnv era ->
       LedgerState era ->
       Tx era ->
-      Expectation
+      BaseImpM ()
     )
 iteExpectLedgerRuleConformanceL = lens iteExpectLedgerRuleConformance (\x y -> x {iteExpectLedgerRuleConformance = y})
 
@@ -1071,6 +1084,8 @@ submitTx_ = void . submitTx
 submitTx :: (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era (Tx era)
 submitTx tx = trySubmitTx tx >>= expectRightDeepExpr . first fst
 
+-- TODO remove this once we get rid of the CPP directives
+{- FOURMOLU_DISABLE -}
 trySubmitTx ::
   forall era.
   ( ShelleyEraImp era
@@ -1090,7 +1105,12 @@ trySubmitTx tx = do
 
   -- Check for conformance
   asks iteExpectLedgerRuleConformance
+  -- TODO get rid of the CPP once we have deprecated GHC8
+#if __GLASGOW_HASKELL__ < 906
     >>= (\f -> liftIO $ f globals res lEnv (st ^. nesEsL . esLStateL) txFixed)
+#else
+    >>= (\f -> f globals res lEnv (st ^. nesEsL . esLStateL) txFixed)
+#endif
 
   case res of
     Left predFailures -> do
@@ -1123,6 +1143,7 @@ trySubmitTx tx = do
             | otherwise = error "Root not found in UTxO"
       impRootTxInL .= newRoot
       pure $ Right txFixed
+{- FOURMOLU_ENABLE -}
 
 -- | Submit a transaction that is expected to be rejected with the given predicate failures.
 -- The inputs and outputs are automatically balanced.

libs/cardano-ledger-conformance/test/Test/Cardano/Ledger/Conformance/Imp.hs

@@ -7,6 +7,8 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
 
 module Test.Cardano.Ledger.Conformance.Imp (spec) where
 
@@ -34,6 +36,8 @@ import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Imp.Common hiding (Args)
 import UnliftIO (evaluateDeep)
 
+-- TODO remove this once we get rid of the CPP directives
+{- FOURMOLU_DISABLE -}
 testImpConformance ::
   forall era.
   ( ConwayEraImp era
@@ -53,6 +57,7 @@ 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
@@ -61,8 +66,8 @@ testImpConformance ::
   ExecEnvironment ConwayFn "LEDGER" era ->
   ExecState ConwayFn "LEDGER" era ->
   ExecSignal ConwayFn "LEDGER" era ->
-  Expectation
-testImpConformance _ impRuleResult env state signal = do
+  BaseImpM ()
+testImpConformance globals impRuleResult env state signal = do
   let ctx =
         ConwayLedgerExecContext
           { clecPolicyHash =
@@ -100,8 +105,26 @@ testImpConformance _ impRuleResult env state signal = do
           (toTestRep . inject @_ @(ExecState ConwayFn "LEDGER" era) . fst)
           impRuleResult
 
-  when (impResponse /= agdaResponse) $ do
+#if __GLASGOW_HASKELL__ >= 906
+  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
+  logDoc $ diffConformance impResponse agdaResponse
+#endif
+  when (impResponse /= agdaResponse) $
     assertFailure "Conformance failure"
+{- FOURMOLU_ENABLE -}
 
 spec :: Spec
 spec =