Skip to content

Commit f2b1495

Browse files
author
euonymos
committed
chore: clean up the code
1 parent 2a866fd commit f2b1495

File tree

14 files changed

+61
-243
lines changed

14 files changed

+61
-243
lines changed

cabal.project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ source-repository-package
2222
tag: d5b0e7ce07258482d53704ce19383013b1fa6610
2323
--sha256: 6+Os/mQDzBOU+TkTD+n/T1MFcI+Mn0/tcBMJhLRfqyA=
2424

25-
-- FIXME: Cannot use new commit, because it requires `plutus-ledger-api==1.29`
25+
-- Cannot use new commit, because it requires `plutus-ledger-api==1.29`
2626
source-repository-package
2727
type: git
2828
location: https://github.com/Plutonomicon/plutarch-plutus

cem-script.cabal

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,11 @@ flag dev
1515
default: True
1616
manual: False
1717

18+
flag force-recomp
19+
description: Compile with -fforce-recomp and -Wunused-packages
20+
default: False
21+
1822
common common-lang
19-
-- Options from MLabs styleguide
2023

2124
ghc-options:
2225
-Wall -Wcompat -Wincomplete-record-updates
@@ -26,6 +29,12 @@ common common-lang
2629
if !flag(dev)
2730
ghc-options: -Werror
2831

32+
if flag(dev)
33+
default-extensions: PartialTypeSignatures
34+
35+
if flag(force-recomp)
36+
ghc-options: -fforce-recomp -Wunused-packages
37+
2938
build-depends:
3039
, base
3140
, extra
@@ -53,9 +62,6 @@ common common-lang
5362
UndecidableInstances
5463
ViewPatterns
5564

56-
if flag(dev)
57-
default-extensions: PartialTypeSignatures
58-
5965
default-language: GHC2021
6066

6167
common common-onchain
@@ -150,7 +156,6 @@ library
150156
Cardano.CEM.Indexing.Tx
151157
Cardano.CEM.Monads
152158
Cardano.CEM.Monads.CLB
153-
Cardano.CEM.Monads.L1
154159
Cardano.CEM.OffChain
155160
Cardano.CEM.OnChain
156161
Cardano.CEM.Testing.StateMachine

src-lib/cardano-extras/Cardano/Extras.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -275,7 +275,6 @@ mintedTokens ::
275275
[(AssetName, Quantity)] ->
276276
Cardano.TxMintValue BuildTx Era
277277
mintedTokens script redeemer assets =
278-
-- FIXME: is hardcoding era correct?
279278
TxMintValue Cardano.MaryEraOnwardsBabbage mintedTokens' mintedWitnesses'
280279
where
281280
mintedTokens' = valueFromList (fmap (first (AssetId policyId)) assets)

src-lib/data-spine/Data/Spine.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -88,8 +88,6 @@ deriveSpine name = do
8888
suffix = "Spine"
8989
spineName = addSuffix name suffix
9090
spineDec <- deriveTags name suffix [''Eq, ''Ord, ''Enum, ''Show]
91-
-- TODO: derive Sing
92-
-- TODO: derive HasField (OfSpine ...)
9391

9492
decls <-
9593
[d|

src/Cardano/CEM.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -111,7 +111,7 @@ class
111111
type EqShow datatype =
112112
( Prelude.Eq datatype
113113
, Prelude.Show datatype
114-
-- TODO: add IsData here? (now it breaks Plutus compilation)
114+
-- Shoul we add IsData here? (now it breaks Plutus compilation)
115115
)
116116

117117
{- | All associated types for 'CEMScript' class defined separately to simplify
@@ -223,7 +223,7 @@ data TxFanKind
223223
-- | Constraint on a single tx fan
224224
data TxFanFilter script = MkTxFanFilter
225225
{ address :: AddressSpec
226-
, rest :: FilterDatum script -- TODO: not ideal naming
226+
, datumFilter :: FilterDatum script
227227
}
228228
deriving stock (Show, Prelude.Eq)
229229

@@ -252,8 +252,8 @@ bySameCEM = UnsafeBySameCEM . toBuiltinData
252252

253253
-- | How many tx fans should satify a 'TxFansConstraint'
254254
data Quantifier
255-
= ExactlyNFans Integer -- TODO: use natural numbers
256-
| FansWithTotalValueOfAtLeast Value -- TODO: use natural numbers
255+
= ExactlyNFans Integer -- Here we'd better use natural numbers
256+
| FansWithTotalValueOfAtLeast Value
257257
deriving stock (Show)
258258

259259
-- | A constraint on Tx inputs or Outputs.

src/Cardano/CEM/Indexing/Event.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,6 @@ import Prelude
4343
(3) For the final transition the situation is like (2) except the target
4444
datum is missing, which doesn't matter.
4545
46-
4746
TODO: How we can improve this in the future:
4847
* API is probably bad, as we always have some transition like Init state -
4948
which you can decode, as you have State. If one changes data

src/Cardano/CEM/Monads.hs

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,6 @@ data CEMAction script
2929
deriving stock instance
3030
(CEMScript script) => Show (CEMAction script)
3131

32-
-- FIXME: use generic Some
3332
data SomeCEMAction where
3433
MkSomeCEMAction ::
3534
forall script.
@@ -38,7 +37,6 @@ data SomeCEMAction where
3837
SomeCEMAction
3938

4039
instance Show SomeCEMAction where
41-
-- FIXME: show script name
4240
show :: SomeCEMAction -> String
4341
show (MkSomeCEMAction action) = show action
4442

@@ -54,8 +52,7 @@ data TxSpec = MkTxSpec
5452
data BlockchainParams = MkBlockchainParams
5553
{ protocolParameters :: PParams LedgerEra
5654
, systemStart :: SystemStart
57-
, -- FIXME: rename
58-
eraHistory :: LedgerEpochInfo
55+
, ledgerEpochInfo :: LedgerEpochInfo
5956
, stakePools :: Set PoolId
6057
}
6158
deriving stock (Show)

src/Cardano/CEM/Monads/CLB.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,14 +60,14 @@ instance
6060
queryBlockchainParams = do
6161
protocolParameters <- gets (mockConfigProtocol . mockConfig)
6262
slotConfig <- gets (mockConfigSlotConfig . mockConfig)
63-
eraHistory <- LedgerEpochInfo <$> getEpochInfo
63+
ledgerEpochInfo <- LedgerEpochInfo <$> getEpochInfo
6464
let systemStart =
6565
SystemStart $ posixTimeToUTCTime $ scSlotZeroTime slotConfig
6666
return $
6767
MkBlockchainParams
6868
{ protocolParameters
6969
, systemStart
70-
, eraHistory
70+
, ledgerEpochInfo
7171
, -- Staking is not supported
7272
stakePools = Set.empty
7373
}

src/Cardano/CEM/Monads/L1.hs

Lines changed: 0 additions & 151 deletions
This file was deleted.

src/Cardano/CEM/Monads/L1Commons.hs

Lines changed: 9 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -3,31 +3,23 @@
33
-- | Code common for resolving Tx of backends which use `cardano-api`
44
module Cardano.CEM.Monads.L1Commons where
55

6-
import Prelude
7-
8-
import Data.List (nub)
9-
import Data.Map qualified as Map
10-
11-
-- Cardano imports
126
import Cardano.Api hiding (queryUtxo)
137
import Cardano.Api.Shelley (LedgerProtocolParameters (..))
14-
15-
-- Project imports
168
import Cardano.CEM.Monads
179
import Cardano.CEM.OffChain
1810
import Cardano.Extras
11+
import Data.List (nub)
12+
import Data.Map qualified as Map
1913
import Data.Maybe (mapMaybe)
14+
import Prelude
2015

21-
-- Main function
22-
16+
-- | Main function
2317
cardanoTxBodyFromResolvedTx ::
2418
(MonadQueryUtxo m, MonadBlockchainParams m) =>
2519
ResolvedTx ->
2620
m (Either (TxBodyErrorAutoBalance Era) (TxBodyContent BuildTx Era, TxBody Era, TxInMode, UTxO Era))
2721
cardanoTxBodyFromResolvedTx (MkResolvedTx {..}) = do
28-
-- (lowerBound, upperBound) <- convertValidityBound validityBound
2922

30-
-- FIXME: proper fee coverage selection
3123
utxo <- queryUtxo $ ByAddresses [signingKeyToAddress signer]
3224
let
3325
feeTxIns = Map.keys $ unUTxO utxo
@@ -41,8 +33,7 @@ cardanoTxBodyFromResolvedTx (MkResolvedTx {..}) = do
4133

4234
let preBody =
4335
TxBodyContent
44-
{ -- FIXME: duplicate TxIn for coin-selection redeemer bug
45-
txIns = nub allTxIns
36+
{ txIns = nub allTxIns -- duplicate TxIn for coin-selection redeemer bug
4637
, txInsCollateral =
4738
TxInsCollateral AlonzoEraOnwardsBabbage feeTxIns
4839
, txInsReference =
@@ -98,14 +89,14 @@ cardanoTxBodyFromResolvedTx (MkResolvedTx {..}) = do
9889
recordFee txInsUtxo body@(TxBody content) = do
9990
case txFee content of
10091
TxFeeExplicit era coin -> do
101-
MkBlockchainParams {protocolParameters, systemStart, eraHistory} <-
92+
MkBlockchainParams {protocolParameters, systemStart, ledgerEpochInfo} <-
10293
queryBlockchainParams
10394
Right report <-
10495
return $
10596
evaluateTransactionExecutionUnits
10697
(shelleyBasedToCardanoEra era)
10798
systemStart
108-
eraHistory
99+
ledgerEpochInfo
109100
(LedgerProtocolParameters protocolParameters)
110101
txInsUtxo
111102
body
@@ -150,13 +141,13 @@ callBodyAutoBalance
150141
preBody
151142
utxo
152143
changeAddress = do
153-
MkBlockchainParams {protocolParameters, systemStart, eraHistory, stakePools} <-
144+
MkBlockchainParams {protocolParameters, systemStart, ledgerEpochInfo, stakePools} <-
154145
queryBlockchainParams
155146
let result =
156147
makeTransactionBodyAutoBalance @Era
157148
shelleyBasedEra
158149
systemStart
159-
eraHistory
150+
ledgerEpochInfo
160151
(LedgerProtocolParameters protocolParameters)
161152
stakePools
162153
Map.empty -- Stake credentials

0 commit comments

Comments
 (0)