Remove CPP pragmas for GHC 810

aniketd · aniketd · commit 664b59943e70 · 2025-05-16T13:23:19.000+05:30
diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs
@@ -5,9 +5,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-#if __GLASGOW_HASKELL__ < 900
-{-# LANGUAGE IncoherentInstances #-}
-#endif
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Cardano.Ledger.Babbage.ImpTest (
diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
@@ -24,7 +24,6 @@
 
 module Test.Cardano.Ledger.Shelley.ImpTest (
   ImpTestM,
-  BaseImpM,
   LedgerSpec,
   SomeSTSEvent (..),
   ImpTestState,
@@ -267,20 +266,6 @@ 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
@@ -594,14 +579,15 @@ modifyImpInitProtVer ver =
 
 modifyImpInitExpectLedgerRuleConformance ::
   forall era.
-  ( Globals ->
+  ( forall t.
+    Globals ->
     Either
       (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
       (State (EraRule "LEDGER" era), [Event (EraRule "LEDGER" era)]) ->
     LedgerEnv era ->
     LedgerState era ->
     Tx era ->
-    BaseImpM ()
+    ImpM t ()
   ) ->
   SpecWith (ImpInit (LedgerSpec era)) ->
   SpecWith (ImpInit (LedgerSpec era))
@@ -753,14 +739,15 @@ 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 ->
-      BaseImpM ()
+      ImpM t ()
   , iteCborRoundTripFailures :: Bool
   -- ^ Expect failures in CBOR round trip serialization tests for predicate failures
   }
@@ -772,14 +759,15 @@ iteExpectLedgerRuleConformanceL ::
   forall era.
   Lens'
     (ImpTestEnv era)
-    ( Globals ->
+    ( forall t.
+      Globals ->
       Either
         (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
         (State (EraRule "LEDGER" era), [Event (EraRule "LEDGER" era)]) ->
       LedgerEnv era ->
       LedgerState era ->
       Tx era ->
-      BaseImpM ()
+      ImpM t ()
     )
 iteExpectLedgerRuleConformanceL = lens iteExpectLedgerRuleConformance (\x y -> x {iteExpectLedgerRuleConformance = y})
 
@@ -1037,8 +1025,6 @@ 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
@@ -1058,12 +1044,7 @@ 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
@@ -1097,7 +1078,6 @@ trySubmitTx tx = do
       impRootTxInL .= newRoot
       expectTxSuccess txFixed
       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.
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
@@ -47,10 +47,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.
+  forall era t.
   ( ConwayEraImp era
   , ExecSpecRule "LEDGER" era
   , ExecContext "LEDGER" era ~ ConwayLedgerExecContext era
@@ -74,7 +72,7 @@ testImpConformance ::
   ExecEnvironment "LEDGER" era ->
   ExecState "LEDGER" era ->
   ExecSignal "LEDGER" era ->
-  BaseImpM ()
+  ImpM t ()
 testImpConformance _globals impRuleResult env state signal = do
   let ctx =
         ConwayLedgerExecContext
@@ -113,7 +111,6 @@ testImpConformance _globals impRuleResult env state signal = do
           (toTestRep . inject @_ @(ExecState "LEDGER" era) . fst)
           impRuleResult
 
-#if __GLASGOW_HASKELL__ >= 906
   logString "implEnv"
   logToExpr env
   logString "implState"
@@ -136,10 +133,8 @@ testImpConformance _globals impRuleResult env state signal = do
       signal
       (first showOpaqueErrorString impRuleResult)
   logDoc $ diffConformance impResponse agdaResponse
-#endif
   when (impResponse /= agdaResponse) $
     assertFailure "Conformance failure"
-{- FOURMOLU_ENABLE -}
 
 spec :: Spec
 spec =
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes/NonZero.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes/NonZero.hs
@@ -48,9 +48,6 @@ import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32, Word64, Word8)
 import GHC.TypeLits
 import NoThunks.Class (NoThunks)
-#if __GLASGOW_HASKELL__ < 900
-import Numeric.Natural (Natural)
-#endif
 
 class KnownBounds a where
   type MinBound a :: Nat
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/HKD.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/HKD.hs
@@ -17,9 +17,7 @@ module Cardano.Ledger.HKD (
   NoUpdate (..),
   HKDApplicative (..),
 ) where
-#if __GLASGOW_HASKELL__ < 906
-import Control.Applicative (liftA2)
-#endif
+
 import Control.DeepSeq (NFData)
 import Data.Functor.Identity (Identity)
 import Data.Maybe.Strict (StrictMaybe (..))
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Basic.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Basic.hs
@@ -16,12 +16,6 @@
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
--- RecordWildCards cause name shadowing warnings in ghc-8.10.
-#if __GLASGOW_HASKELL__ < 900
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-{-# OPTIONS_GHC -O0 #-}
-#endif
-
 -- | This module provides `HasSpec` and `HasSimpleRep` instances for
 --   Basic types. A type is 'Basic' if it is used to define PParams.
 --   See Test.Cardano.Ledger.Constrained.Conway.SimplePParams
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Ledger.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Ledger.hs
@@ -19,17 +19,10 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 -- GHC9.2.8 needs this
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
--- RecordWildCards cause name shadowing warnings in ghc-8.10.
-#if __GLASGOW_HASKELL__ < 900
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-{-# OPTIONS_GHC -O0 #-}
-#endif
-
 -- | This module provides the necessary instances of `HasSpec`
 -- and `HasSimpleRep` to write specs for the environments,
 -- states, and signals in the STS rules of the Ledger. Note some simple
@@ -1092,7 +1085,7 @@ instance (Era era, EraSpecPParams era) => HasSpec (GovActionState era)
 
 gasId_ ::
   Term (GovActionState ConwayEra) ->
-  Term (GovActionId)
+  Term GovActionId
 gasId_ = sel @0
 
 gasCommitteeVotes_ ::
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/PParams.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/PParams.hs
@@ -14,11 +14,6 @@
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
--- RecordWildCards cause name shadowing warnings in ghc-8.10.
-#if __GLASGOW_HASKELL__ < 900
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-#endif
-
 -- | This module provides the necessary instances of `HasSpec`
 --   and `HasSimpleRep` for the components of PParams. It hides
 --   the fact that (PParams era) can have different underlying 'data' types
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/WellFormed.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/WellFormed.hs
@@ -12,10 +12,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 
-#if __GLASGOW_HASKELL__ < 900
-{-# OPTIONS_GHC -O0 #-}
-#endif
-
 module Test.Cardano.Ledger.Constrained.Conway.LedgerTypes.WellFormed where
 
 import Cardano.Ledger.Api
diff --git a/libs/constrained-generators/src/Constrained/NumSpec.hs b/libs/constrained-generators/src/Constrained/NumSpec.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -18,7 +17,6 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
 -- Random Natural, Arbitrary Natural, Uniform Natural
 {-# OPTIONS_GHC -Wno-orphans #-}
 
diff --git a/libs/constrained-generators/src/Constrained/Spec/Map.hs b/libs/constrained-generators/src/Constrained/Spec/Map.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -53,7 +52,7 @@ instance Ord a => Sized (Map.Map a b) where
   sizeOf = toInteger . Map.size
   liftSizeSpec sz cant = typeSpec $ defaultMapSpec {mapSpecSize = TypeSpec sz cant}
   liftMemberSpec xs = case NE.nonEmpty (nubOrd xs) of
-    Nothing -> ErrorSpec (pure ("In liftMemberSpec for the (Sized Map) instance, xs is the empty list"))
+    Nothing -> ErrorSpec (pure "In liftMemberSpec for the (Sized Map) instance, xs is the empty list")
     Just ys -> typeSpec $ defaultMapSpec {mapSpecSize = MemberSpec ys}
   sizeOfTypeSpec (MapSpec _ mustk mustv size _ _) =
     geqSpec (sizeOf mustk)
@@ -226,7 +225,7 @@ instance
     !mustMap <- explain "Make the mustMap" $ forM (Set.toList mustKeys) $ \k -> do
       let vSpec = constrained $ \v -> satisfies (pair_ (Lit k) v) kvs
       v <- explain (show $ "vSpec =" <+> pretty vSpec) $ genFromSpecT vSpec
-      pure $ (k, v)
+      pure (k, v)
     let haveVals = map snd mustMap
         mustVals' = filter (`notElem` haveVals) mustVals
         size' = simplifySpec $ constrained $ \sz ->
@@ -282,7 +281,7 @@ instance
   shrinkWithTypeSpec (MapSpec _ _ _ _ kvs _) m = map Map.fromList $ shrinkList (shrinkWithSpec kvs) (Map.toList m)
 
   toPreds m (MapSpec mHint mustKeys mustVals size kvs foldSpec) =
-    toPred $
+    toPred
       [ Assert $ Lit mustKeys `subset_` dom_ m
       , forAll (Lit mustVals) $ \val ->
           val `elem_` rng_ m
@@ -394,7 +393,7 @@ instance Logic MapW where
           )
 
   mapTypeSpec DomW (MapSpec _ mustSet _ sz kvSpec _) = typeSpec $ SetSpec mustSet (fstSpec kvSpec) sz
-  mapTypeSpec RngW (MapSpec _ _ mustList sz kvSpec foldSpec) = typeSpec $ (ListSpec Nothing mustList sz (sndSpec kvSpec) foldSpec)
+  mapTypeSpec RngW (MapSpec _ _ mustList sz kvSpec foldSpec) = typeSpec $ ListSpec Nothing mustList sz (sndSpec kvSpec) foldSpec
 
 ------------------------------------------------------------------------
 -- Syntax
diff --git a/libs/constrained-generators/src/Constrained/Spec/Set.hs b/libs/constrained-generators/src/Constrained/Spec/Set.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -16,7 +15,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -76,7 +74,7 @@ instance Ord a => Sized (Set.Set a) where
   sizeOf = toInteger . Set.size
   liftSizeSpec spec cant = typeSpec (SetSpec mempty TrueSpec (TypeSpec spec cant))
   liftMemberSpec xs = case NE.nonEmpty xs of
-    Nothing -> ErrorSpec (pure ("In liftMemberSpec for the (Sized Set) instance, xs is the empty list"))
+    Nothing -> ErrorSpec (pure "In liftMemberSpec for the (Sized Set) instance, xs is the empty list")
     Just zs -> typeSpec (SetSpec mempty TrueSpec (MemberSpec zs))
   sizeOfTypeSpec (SetSpec must _ sz) = sz <> geqSpec (sizeOf must)
 
@@ -124,7 +122,7 @@ guardSetSpec es (SetSpec must elemS ((<> geqSpec 0) -> size))
   | isErrorLike (maxSpec (cardinality elemS) <> size) =
       ErrorSpec $
         NE.fromList $
-          [ "Cardinality of SetSpec elemSpec (" ++ show (elemS) ++ ") = " ++ show (maxSpec (cardinality elemS))
+          [ "Cardinality of SetSpec elemSpec (" ++ show elemS ++ ") = " ++ show (maxSpec (cardinality elemS))
           , "   This is inconsistent with SetSpec size (" ++ show size ++ ")"
           ]
             ++ es
@@ -171,7 +169,7 @@ instance (Ord a, HasSpec a) => HasSpec (Set a) where
     let additions = Set.fromList $ take (size - Set.size must) choices
     pure (Set.union must additions)
   genFromTypeSpec (SetSpec must elemS szSpec) = do
-    let szSpec' = (szSpec <> geqSpec (sizeOf must) <> maxSpec (cardinality elemS))
+    let szSpec' = szSpec <> geqSpec (sizeOf must) <> maxSpec (cardinality elemS)
     count <-
       explain "Choose a size for the Set to be generated" $
         genFromSpecT szSpec'
diff --git a/libs/constrained-generators/src/Constrained/Spec/SumProd.hs b/libs/constrained-generators/src/Constrained/Spec/SumProd.hs
@@ -1,26 +1,23 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstrainedClassMethods #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
@@ -236,7 +233,7 @@ instance {-# OVERLAPPABLE #-} Args a ~ '[a] => IsProd a where
 
 instance IsProd b => IsProd (Prod a b) where
   toArgs (p :: Term (Prod a b))
-    | Evidence <- prerequisites @(Prod a b) = (prodFst_ p) :> toArgs (prodSnd_ p)
+    | Evidence <- prerequisites @(Prod a b) = prodFst_ p :> toArgs (prodSnd_ p)
 
 type family Args t where
   Args (Prod a b) = a : Args b
@@ -388,10 +385,10 @@ snd_ :: (HasSpec x, HasSpec y) => Term (x, y) -> Term y
 snd_ = appTerm (ComposeW ProdSndW ToGenericW)
 
 fstW :: (HasSpec a, HasSpec b) => FunW '[(a, b)] a
-fstW = (ComposeW ProdFstW ToGenericW)
+fstW = ComposeW ProdFstW ToGenericW
 
 sndW :: (HasSpec a, HasSpec b) => FunW '[(a, b)] b
-sndW = (ComposeW ProdSndW ToGenericW)
+sndW = ComposeW ProdSndW ToGenericW
 
 instance
   (HasSpec a, HasSpec b, Arbitrary (FoldSpec a), Arbitrary (FoldSpec b)) =>
diff --git a/libs/ledger-state/bench/Address.hs b/libs/ledger-state/bench/Address.hs
