fmt

eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Proposals.hs

@@ -111,7 +111,7 @@ module Cardano.Ledger.Conway.Governance.Proposals (
   peChildrenL,
   PGraph (..),
   pGraphNodesL,
-  proposalsDeposits
+  proposalsDeposits,
 ) where
 
 import Cardano.Ledger.Address (rewardAccountCredentialL)

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -347,14 +347,17 @@ instance
     pure $ ProposalsNewActions ps gass
 
 instance
-  (EraPParams era, Arbitrary (PParamsUpdate era), Arbitrary (PParamsHKD StrictMaybe era)) =>
+  (EraPParams era, Arbitrary (PParamsHKD StrictMaybe era)) =>
   Arbitrary (Proposals era)
   where
   arbitrary = genProposals (0, 30)
-  shrink ps = [ ps' | gais' <- shrink gais
-                           , let (ps', _) = proposalsRemoveWithDescendants (gais Set.\\ gais') ps
-                           ]
-    where gais = Set.fromList (toList $ proposalsIds ps)
+  shrink ps =
+    [ ps'
+    | gais' <- shrink gais
+    , let (ps', _) = proposalsRemoveWithDescendants (gais Set.\\ gais') ps
+    ]
+    where
+      gais = Set.fromList (toList $ proposalsIds ps)
 
 genProposals ::
   forall era.

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

@@ -1,36 +1,30 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Specs necessary to generate, environment, state, and signal
 -- for the EPOCH rule
 module Test.Cardano.Ledger.Constrained.Conway.Epoch where
 
-import Control.Lens
-import qualified Data.Set as Set
-import Data.Set (Set)
-import Data.Foldable
-import Data.Sequence.Strict
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin
 import Cardano.Ledger.Conway (Conway, ConwayEra)
 import Cardano.Ledger.Conway.Governance
-import Control.Monad.Identity
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (StandardCrypto)
 import Cardano.Ledger.Shelley.API.Types
 import Constrained
+import Control.Lens
+import Data.Foldable
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
 import GHC.Generics (Generic)
 import Test.Cardano.Ledger.Constrained.Conway.Gov
 import Test.Cardano.Ledger.Constrained.Conway.Instances
-import Cardano.Ledger.Conway.Governance
 
 newtype EpochExecEnv era = EpochExecEnv
   { eeeStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
@@ -43,7 +37,7 @@ epochEnvSpec = TrueSpec
 epochStateSpec ::
   Term ConwayFn EpochNo ->
   Specification ConwayFn (EpochState (ConwayEra StandardCrypto))
-epochStateSpec epochNo = constrained $ \ es ->
+epochStateSpec epochNo = constrained $ \es ->
   match es $ \_accountState ledgerState _snapShots _nonMyopic ->
     match ledgerState $ \utxoState certState ->
       match utxoState $ \_utxo _deposited _fees govState _stakeDistr _donation ->
@@ -59,25 +53,25 @@ epochStateSpec epochNo = constrained $ \ es ->
                     , forAll pulseProposals $ \gas ->
                         match gas $ \gasId _ _ _ _ _ _ ->
                           proposalExists gasId proposals
-                    -- TODO: something is wrong in this case and I haven't figured out what yet
-                    , assert False
+                    , -- TODO: something is wrong in this case and I haven't figured out what yet
+                      assert False
                     ]
               )
               -- DRComplete
               ( branch $ \_snap ratifyState ->
                   match ratifyState $ \enactState [var| enacted |] expired _delayed ->
-                    [ forAll expired $ \[var| gasId |] ->
+                    [ forAll expired $ \ [var| gasId |] ->
                         proposalExists gasId proposals
-                    -- TODO: this isn't enough, we need to ensure it's at most
-                    -- one of each type of action that's being enacted
-                    , forAll enacted $ \govact ->
-                        [ reify proposals enactableProposals $ \ enactable -> govact `elem_` enactable
+                    , -- TODO: this isn't enough, we need to ensure it's at most
+                      -- one of each type of action that's being enacted
+                      forAll enacted $ \govact ->
+                        [ reify proposals enactableProposals $ \enactable -> govact `elem_` enactable
                         , assert $ not_ $ gasId_ govact `member_` expired
                         ]
-                    -- TODO: this is a hack to get around the todo above!
-                    , assert $ sizeOf_ enacted <=. 1
+                    , -- TODO: this is a hack to get around the todo above!
+                      assert $ sizeOf_ enacted <=. 1
                     , match enactState $
-                        \ _cc _con _cpp _ppp _tr _wth prevGACTIDS ->
+                        \_cc _con _cpp _ppp _tr _wth prevGACTIDS ->
                           reify proposals (toPrevGovActionIds . view pRootsL) (prevGACTIDS ==.)
                     ]
               )
@@ -97,17 +91,20 @@ epochSignalSpec curEpoch = constrained $ \e ->
 
 enactableProposals :: Proposals era -> [GovActionState era]
 enactableProposals proposals =
-  [ gact' | gact <- toList (proposalsActions proposals)
-          , gact' <- withGovActionParent gact [gact]
-                      $ \ _ mparent _ ->
-                          case mparent of
-                            SNothing -> [gact]
-                            SJust (GovPurposeId gpid')
-                              | isRoot gpid' proposals -> [gact]
-                              | otherwise              -> []
+  [ gact'
+  | gact <- toList (proposalsActions proposals)
+  , gact' <- withGovActionParent gact [gact] $
+      \_ mparent _ ->
+        case mparent of
+          SNothing -> [gact]
+          SJust (GovPurposeId gpid')
+            | isRoot gpid' proposals -> [gact]
+            | otherwise -> []
   ]
 
 isRoot :: GovActionId (EraCrypto era) -> Proposals era -> Bool
-isRoot gid (view pRootsL -> GovRelation{..}) =
-  SJust gid `elem` [getGID grPParamUpdate, getGID grHardFork, getGID grCommittee, getGID grConstitution]
-  where getGID = fmap unGovPurposeId . prRoot
+isRoot gid (view pRootsL -> GovRelation {..}) =
+  SJust gid
+    `elem` [getGID grPParamUpdate, getGID grHardFork, getGID grCommittee, getGID grConstitution]
+  where
+    getGID = fmap unGovPurposeId . prRoot

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

@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
@@ -20,6 +19,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
@@ -64,9 +64,6 @@ module Test.Cardano.Ledger.Constrained.Conway.Instances.Ledger (
   module Test.Cardano.Ledger.Constrained.Conway.Instances.Basic,
 ) where
 
-import Test.Cardano.Ledger.Conway.Arbitrary
-import Constrained.Univ
-
 import Cardano.Chain.Common (
   AddrAttributes (..),
   AddrType (..),
@@ -139,10 +136,11 @@ import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
 import Cardano.Ledger.UMap
 import Cardano.Ledger.UTxO
 import Cardano.Ledger.Val (Val)
-import Constrained hiding (Value, Sized)
+import Constrained hiding (Sized, Value)
 import Constrained qualified as C
 import Constrained.Base (Binder (..), HasGenHint (..), Pred (..), Term (..))
 import Constrained.Spec.Map
+import Constrained.Univ
 import Control.DeepSeq (NFData)
 import Crypto.Hash (Blake2b_224)
 import Data.ByteString qualified as BS
@@ -175,6 +173,7 @@ import PlutusLedgerApi.V1 qualified as PV1
 import Test.Cardano.Ledger.Allegra.Arbitrary ()
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Constrained.Conway.Instances.Basic
+import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Core.Utils
 import Test.Cardano.Ledger.Shelley.Utils
 import Test.Cardano.Ledger.TreeDiff (ToExpr)
@@ -1129,7 +1128,9 @@ instance EraPParams era => HasSimpleRep (Proposals era) where
 instance (EraSpecPParams era, IsConwayUniv fn, Arbitrary (Proposals era)) => HasSpec fn (Proposals era) where
   shrinkWithTypeSpec _ props = shrink props
 
-psPParamUpdate_ :: (EraSpecPParams era, Arbitrary (Proposals era), IsConwayUniv fn) => Term fn (Proposals era) -> Term fn (ProposalTree era)
+psPParamUpdate_ ::
+  (EraSpecPParams era, Arbitrary (Proposals era), IsConwayUniv fn) =>
+  Term fn (Proposals era) -> Term fn (ProposalTree era)
 psPParamUpdate_ = sel @0
 
 data ProposalsSplit = ProposalsSplit

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

@@ -29,7 +29,7 @@ import Cardano.Ledger.Mary.Value (MultiAsset (..))
 import Cardano.Ledger.Shelley.PParams (Update (..))
 import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
 import Cardano.Ledger.TxIn (TxIn (..))
-import Constrained hiding (Value, Sized)
+import Constrained hiding (Sized, Value)
 import Data.Foldable (toList)
 import Data.Map.Strict (Map)
 import qualified Data.Sequence.Strict as SS (fromList)

libs/constrained-generators/src/Constrained/Base.hs

@@ -49,10 +49,9 @@
 -- depends in turn on `Pred` and so on.
 module Constrained.Base where
 
-import Control.Exception (catch, SomeException)
-import System.IO.Unsafe
 import Control.Applicative
 import Control.Arrow (first)
+import Control.Exception (SomeException, catch)
 import Control.Monad
 import Control.Monad.Identity
 import Control.Monad.Writer (Writer, runWriter, tell)
@@ -77,6 +76,7 @@ import GHC.Real
 import GHC.Stack
 import GHC.TypeLits
 import Prettyprinter
+import System.IO.Unsafe
 import System.Random
 import System.Random.Stateful
 import Test.QuickCheck hiding (Args, Fun, forAll)
@@ -1282,7 +1282,9 @@ genFromSpec :: forall fn a. (HasCallStack, HasSpec fn a) => Specification fn a -
 genFromSpec spec = do
   res <- strictGen $ explain1 "Calling genFromSpec" $ do
     r <- genFromSpecT spec
-    unsafePerformIO $ r `seq` pure (pure r) `catch` \ (e :: SomeException) -> pure (fatalError (pure $ show e))
+    unsafePerformIO $
+      r `seq`
+        pure (pure r) `catch` \(e :: SomeException) -> pure (fatalError (pure $ show e))
   errorGE $ fmap pure res
 
 -- | A version of `genFromSpecT` that takes a seed and a size and gives you a result
@@ -5755,15 +5757,36 @@ class Sized fn t where
   sizeOf = sizeOf @fn . toSimpleRep
 
   liftSizeSpec :: HasSpec fn t => SizeSpec fn -> [Integer] -> Specification fn t
-  default liftSizeSpec :: (HasSpec fn t, HasSimpleRep t, Sized fn (SimpleRep t), HasSpec fn (SimpleRep t), TypeSpec fn t ~ TypeSpec fn (SimpleRep t)) => SizeSpec fn -> [Integer] -> Specification fn t
+  default liftSizeSpec ::
+    ( HasSpec fn t
+    , HasSimpleRep t
+    , Sized fn (SimpleRep t)
+    , HasSpec fn (SimpleRep t)
+    , TypeSpec fn t ~ TypeSpec fn (SimpleRep t)
+    ) =>
+    SizeSpec fn -> [Integer] -> Specification fn t
   liftSizeSpec sz cant = fromSimpleRepSpec $ liftSizeSpec sz cant
 
   liftMemberSpec :: HasSpec fn t => OrdSet Integer -> Specification fn t
-  default liftMemberSpec :: (HasSpec fn t, HasSpec fn (SimpleRep t), HasSimpleRep t, Sized fn (SimpleRep t),TypeSpec fn t ~ TypeSpec fn (SimpleRep t)) => OrdSet Integer -> Specification fn t
+  default liftMemberSpec ::
+    ( HasSpec fn t
+    , HasSpec fn (SimpleRep t)
+    , HasSimpleRep t
+    , Sized fn (SimpleRep t)
+    , TypeSpec fn t ~ TypeSpec fn (SimpleRep t)
+    ) =>
+    OrdSet Integer -> Specification fn t
   liftMemberSpec = fromSimpleRepSpec . liftMemberSpec
 
   sizeOfTypeSpec :: HasSpec fn t => TypeSpec fn t -> Specification fn Integer
-  default sizeOfTypeSpec :: (HasSpec fn t, HasSpec fn (SimpleRep t), HasSimpleRep t, Sized fn (SimpleRep t),TypeSpec fn t ~ TypeSpec fn (SimpleRep t)) => TypeSpec fn t -> Specification fn Integer
+  default sizeOfTypeSpec ::
+    ( HasSpec fn t
+    , HasSpec fn (SimpleRep t)
+    , HasSimpleRep t
+    , Sized fn (SimpleRep t)
+    , TypeSpec fn t ~ TypeSpec fn (SimpleRep t)
+    ) =>
+    TypeSpec fn t -> Specification fn Integer
   sizeOfTypeSpec = sizeOfTypeSpec @fn @(SimpleRep t)
 
 instance Ord a => Sized fn (Set.Set a) where

libs/constrained-generators/src/Constrained/Spec/Generics.hs

@@ -389,9 +389,9 @@ cNothing_ = con @"Nothing" (lit ())
 sel ::
   forall n fn a c as.
   ( SimpleRep a ~ ProdOver as
-  -- TODO: possibly investigate deriving this from the actual SOP of SimpleRep, as currently it's buggy if you define
-  -- your own custom SOP-like SimpleRep by defining SimpleRep rather than TheSop (it's stupid I know)
-  , TheSop a ~ '[c ::: as]
+  , -- TODO: possibly investigate deriving this from the actual SOP of SimpleRep, as currently it's buggy if you define
+    -- your own custom SOP-like SimpleRep by defining SimpleRep rather than TheSop (it's stupid I know)
+    TheSop a ~ '[c ::: as]
   , TypeSpec fn a ~ TypeSpec fn (ProdOver as)
   , Select fn n as
   , HasSpec fn a