Skip to content

Commit 891de44

Browse files
Jimbo4350Jimbo4350
authored
Merge pull request #1438 from IntersectMBO/jordan/replace-era-case-combinators
Replace caseShelleyToBabbageOrConwayEraOnwards with inEonForShelleyBasedEra
2 parents 47795e8 + 1722e58 commit 891de44

6 files changed

Lines changed: 94 additions & 81 deletions

File tree

‎.changes/replace-era-case-combinators.yml‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
project: cardano-cli
2+
pr: 1438
3+
kind:
4+
- refactoring
5+
description: |
6+
Replaced uses of cardano-api's `caseShelleyToBabbageOrConwayEraOnwards` with `inEonForShelleyBasedEra`, and dropped the unused `ShelleyToBabbageEra` witness from `UpdateProtocolParametersPreConway` so the pre-Conway protocol parameters update parser no longer needs an era case split.

‎cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs‎

Lines changed: 75 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,11 @@
1-
{-# LANGUAGE DataKinds #-}
21
{-# LANGUAGE GADTs #-}
3-
{-# LANGUAGE ScopedTypeVariables #-}
42

53
module Cardano.CLI.Compatible.Governance.Option
64
( pCompatibleGovernanceCmds
75
)
86
where
97

108
import Cardano.Api
11-
import Cardano.Api.Experimental (obtainCommonConstraints)
129

1310
import Cardano.CLI.Compatible.Governance.Command
1411
import Cardano.CLI.Compatible.Governance.Types
@@ -33,24 +30,29 @@ pCompatibleGovernanceCmds
3330
pCompatibleGovernanceCmds sbe =
3431
asum $
3532
catMaybes
36-
[ caseShelleyToBabbageOrConwayEraOnwards
37-
( const $
38-
subInfoParser
39-
"governance"
40-
( Opt.progDesc $
41-
mconcat
42-
[ "Governance commands."
43-
]
44-
)
45-
[ pCreateMirCertificatesCmds sbe
46-
, pGovernanceGenesisKeyDelegationCertificate
47-
, fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe
48-
]
49-
)
50-
( \w ->
51-
fmap LatestCompatibleGovernanceCmds <$> obtainCommonConstraints (convert w) Latest.pGovernanceCmds
52-
)
53-
sbe
33+
[ case sbe of
34+
ShelleyBasedEraShelley -> preConway
35+
ShelleyBasedEraAllegra -> preConway
36+
ShelleyBasedEraMary -> preConway
37+
ShelleyBasedEraAlonzo -> preConway
38+
ShelleyBasedEraBabbage -> preConway
39+
ShelleyBasedEraConway ->
40+
fmap LatestCompatibleGovernanceCmds <$> Latest.pGovernanceCmds
41+
ShelleyBasedEraDijkstra ->
42+
fmap LatestCompatibleGovernanceCmds <$> Latest.pGovernanceCmds
43+
]
44+
where
45+
preConway =
46+
subInfoParser
47+
"governance"
48+
( Opt.progDesc $
49+
mconcat
50+
[ "Governance commands."
51+
]
52+
)
53+
[ pCreateMirCertificatesCmds sbe
54+
, pGovernanceGenesisKeyDelegationCertificate
55+
, fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe
5456
]
5557

5658
pGovernanceActionCmds
@@ -63,58 +65,64 @@ pGovernanceActionCmds sbe =
6365
[ "Governance action commands."
6466
]
6567
)
66-
[ pGovernanceActionProtocolParametersUpdateCmd sbe
68+
[ Just $ pUpdateProtocolParametersCmd sbe
6769
]
6870

69-
pGovernanceActionProtocolParametersUpdateCmd
70-
:: ()
71-
=> ShelleyBasedEra era
72-
-> Maybe (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
73-
pGovernanceActionProtocolParametersUpdateCmd sbe = do
74-
w <- forShelleyBasedEraMaybeEon sbe
75-
pure $
76-
pUpdateProtocolParametersCmd w
77-
7871
pUpdateProtocolParametersCmd
7972
:: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
80-
pUpdateProtocolParametersCmd =
81-
caseShelleyToBabbageOrConwayEraOnwards
82-
( \shelleyToBab ->
83-
let sbe = convert shelleyToBab
84-
in Opt.hsubparser
85-
$ commandWithMetavar "create-protocol-parameters-update"
86-
$ Opt.info
87-
( GovernanceActionProtocolParametersUpdateCmdArgs
88-
(convert shelleyToBab)
89-
<$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
90-
<*> pure Nothing
91-
<*> pGovActionProtocolParametersUpdate sbe
92-
<*> pCostModelsFile sbe
93-
<*> pOutputFile
94-
)
95-
$ Opt.progDesc "Create a protocol parameters update."
96-
)
97-
( \conwayOnwards ->
98-
let sbe = convert conwayOnwards
99-
ppup = fmap Just (obtainCommonConstraints (convert conwayOnwards) pUpdateProtocolParametersPostConway)
100-
in Opt.hsubparser
101-
$ commandWithMetavar "create-protocol-parameters-update"
102-
$ Opt.info
103-
( GovernanceActionProtocolParametersUpdateCmdArgs
104-
(convert conwayOnwards)
105-
Nothing
106-
<$> ppup
107-
<*> pGovActionProtocolParametersUpdate sbe
108-
<*> pCostModelsFile sbe
109-
<*> pOutputFile
110-
)
111-
$ Opt.progDesc "Create a protocol parameters update."
112-
)
73+
pUpdateProtocolParametersCmd sbe =
74+
case sbe of
75+
ShelleyBasedEraShelley -> pPreConwayUpdateProtocolParametersCmd sbe
76+
ShelleyBasedEraAllegra -> pPreConwayUpdateProtocolParametersCmd sbe
77+
ShelleyBasedEraMary -> pPreConwayUpdateProtocolParametersCmd sbe
78+
ShelleyBasedEraAlonzo -> pPreConwayUpdateProtocolParametersCmd sbe
79+
ShelleyBasedEraBabbage -> pPreConwayUpdateProtocolParametersCmd sbe
80+
ShelleyBasedEraConway -> pPostConwayUpdateProtocolParametersCmd sbe
81+
ShelleyBasedEraDijkstra -> pPostConwayUpdateProtocolParametersCmd sbe
82+
83+
pPreConwayUpdateProtocolParametersCmd
84+
:: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
85+
pPreConwayUpdateProtocolParametersCmd sbe =
86+
Opt.hsubparser
87+
$ commandWithMetavar "create-protocol-parameters-update"
88+
$ Opt.info
89+
( GovernanceActionProtocolParametersUpdateCmdArgs sbe
90+
<$> fmap Just pUpdateProtocolParametersPreConway
91+
<*> pure Nothing
92+
<*> pGovActionProtocolParametersUpdate sbe
93+
<*> pCostModelsFile sbe
94+
<*> pOutputFile
95+
)
96+
$ Opt.progDesc "Create a protocol parameters update."
97+
98+
pPostConwayUpdateProtocolParametersCmd
99+
:: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
100+
pPostConwayUpdateProtocolParametersCmd sbe =
101+
Opt.hsubparser
102+
$ commandWithMetavar "create-protocol-parameters-update"
103+
$ Opt.info
104+
( GovernanceActionProtocolParametersUpdateCmdArgs sbe Nothing
105+
<$> pConwayOnwards
106+
<*> pGovActionProtocolParametersUpdate sbe
107+
<*> pCostModelsFile sbe
108+
<*> pOutputFile
109+
)
110+
$ Opt.progDesc "Create a protocol parameters update."
111+
where
112+
pConwayOnwards =
113+
case sbe of
114+
ShelleyBasedEraShelley -> pure Nothing
115+
ShelleyBasedEraAllegra -> pure Nothing
116+
ShelleyBasedEraMary -> pure Nothing
117+
ShelleyBasedEraAlonzo -> pure Nothing
118+
ShelleyBasedEraBabbage -> pure Nothing
119+
ShelleyBasedEraConway -> Just <$> pUpdateProtocolParametersPostConway
120+
ShelleyBasedEraDijkstra -> Just <$> pUpdateProtocolParametersPostConway
113121

114122
pUpdateProtocolParametersPreConway
115-
:: ShelleyToBabbageEra era -> Parser (UpdateProtocolParametersPreConway era)
116-
pUpdateProtocolParametersPreConway shelleyToBab =
117-
UpdateProtocolParametersPreConway shelleyToBab
123+
:: Parser (UpdateProtocolParametersPreConway era)
124+
pUpdateProtocolParametersPreConway =
125+
UpdateProtocolParametersPreConway
118126
<$> pEpochNoUpdateProp
119127
<*> pProtocolParametersUpdateGenesisKeys
120128

‎cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -132,7 +132,7 @@ shelleyToBabbageProtocolParametersUpdate
132132
shelleyToBabbageProtocolParametersUpdate sbe args = do
133133
let oFp = uppFilePath args
134134
anyEra = AnyShelleyBasedEra sbe
135-
UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <-
135+
UpdateProtocolParametersPreConway expEpoch genesisVerKeys <-
136136
fromExceptTCli $
137137
hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $
138138
uppPreConway args

‎cardano-cli/src/Cardano/CLI/Compatible/Governance/Types.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,8 +38,7 @@ data GovernanceActionProtocolParametersUpdateCmdArgs era
3838

3939
data UpdateProtocolParametersPreConway era
4040
= UpdateProtocolParametersPreConway
41-
{ eon :: !(ShelleyToBabbageEra era)
42-
, expiryEpoch :: !EpochNo
41+
{ expiryEpoch :: !EpochNo
4342
, genesisVerificationKeys :: ![VerificationKeyFile In]
4443
}
4544

‎cardano-cli/src/Cardano/CLI/Compatible/Transaction/Option.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE RankNTypes #-}
66
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TypeApplications #-}
78

89
module Cardano.CLI.Compatible.Transaction.Option
910
( pAllCompatibleTransactionCommands
@@ -150,8 +151,8 @@ pTxOutDatum sbe =
150151

151152
pRefScriptFp :: ShelleyBasedEra era -> Parser ReferenceScriptAnyEra
152153
pRefScriptFp =
153-
caseShelleyToBabbageOrConwayEraOnwards
154-
(const $ pure ReferenceScriptAnyEraNone)
154+
inEonForShelleyBasedEra @ConwayEraOnwards
155+
(pure ReferenceScriptAnyEraNone)
155156
( const $
156157
ReferenceScriptAnyEra
157158
<$> parseFilePath "tx-out-reference-script-file" "Reference script input file."
@@ -163,7 +164,7 @@ pVoteFiles
163164
-> BalanceTxExecUnits
164165
-> Parser [(VoteFile In, Maybe AnyNonAssetScript)]
165166
pVoteFiles sbe bExUnits =
166-
caseShelleyToBabbageOrConwayEraOnwards
167-
(const $ pure [])
167+
inEonForShelleyBasedEra @ConwayEraOnwards
168+
(pure [])
168169
(const . many $ pVoteFile bExUnits)
169170
sbe

‎cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -78,13 +78,12 @@ runCompatibleTransactionCmd
7878
]
7979

8080
(protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <-
81-
caseShelleyToBabbageOrConwayEraOnwards
82-
( const $ do
83-
case mUpdateProposal of
84-
Nothing -> return (NoPParamsUpdate sbe, NoVotes)
85-
Just p -> do
86-
pparamUpdate <- readUpdateProposalFile p
87-
return (pparamUpdate, NoVotes)
81+
inEonForShelleyBasedEra
82+
( case mUpdateProposal of
83+
Nothing -> return (NoPParamsUpdate sbe, NoVotes)
84+
Just p -> do
85+
pparamUpdate <- readUpdateProposalFile p
86+
return (pparamUpdate, NoVotes)
8887
)
8988
( \w ->
9089
case mProposalProcedure of

0 commit comments

Comments
 (0)