From e2251022e54d764485f57367f5b9c82c269e37db Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 29 Sep 2022 00:05:06 +1000 Subject: [PATCH 1/3] Syntax changes to accomodate ghc-9.2.4 * Type application symbol @ should not be followed with space * Operators must be separated by spaces * Bang pattern symbol ! must not be followed by space * Use type applications to disambguate use of show * Qualified import for Data.List to avoid ambiguity * Don't hide import of option. Use qualified import of Options.Applicative instead. * Use of $ operator should be followed by whitespace because $( is extrictly for TemplateHaskell * Add missing type signature of top level function * Qualified import of Data.Text.Lazy --- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 8 ++-- .../GeneratorTx/SubmissionClient.hs | 2 +- .../src/Cardano/Benchmarking/Script/Core.hs | 14 +++---- bench/tx-generator/test/Main.hs | 1 + cardano-api/src/Cardano/Api/LedgerEvent.hs | 2 +- cardano-api/src/Cardano/Api/LedgerState.hs | 4 +- .../src/Cardano/Api/TxSubmit/ErrorRender.hs | 12 +++--- cardano-api/src/Cardano/Api/TxSubmit/Types.hs | 2 +- cardano-api/test/Test/Cardano/Api/Crypto.hs | 6 +-- cardano-cli/app/cardano-cli.hs | 2 +- .../src/Cardano/CLI/Byron/Delegation.hs | 2 +- cardano-cli/src/Cardano/CLI/Byron/Genesis.hs | 3 +- cardano-cli/src/Cardano/CLI/Byron/Key.hs | 8 ++-- cardano-cli/src/Cardano/CLI/Byron/Parsers.hs | 40 +++++++++---------- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 4 +- .../src/Cardano/CLI/Shelley/Parsers.hs | 2 +- cardano-node-chairman/app/Cardano/Chairman.hs | 2 +- .../app/Cardano/Chairman/Commands/Run.hs | 7 ++-- cardano-node/app/cardano-node.hs | 2 +- cardano-node/src/Cardano/Node/Parsers.hs | 14 +++---- cardano-node/src/Cardano/Node/Queries.hs | 2 +- .../src/Cardano/Node/Tracing/Era/HardFork.hs | 22 +++++----- .../Cardano/Tracing/OrphanInstances/Common.hs | 3 +- .../Tracing/OrphanInstances/HardFork.hs | 24 +++++------ cardano-node/src/Cardano/Tracing/Tracers.hs | 2 +- .../src/Cardano/TxSubmit/ErrorRender.hs | 12 +++--- .../src/Cardano/Logging/Configuration.hs | 2 +- trace-dispatcher/src/Cardano/Logging/Trace.hs | 6 +-- .../src/Cardano/Logging/Tracer/Composed.hs | 11 ++--- trace-dispatcher/src/Cardano/Logging/Types.hs | 18 ++++----- 30 files changed, 122 insertions(+), 117 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index ff0c23a585b..e51c3d32986 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -57,7 +57,7 @@ assumeMapCosts _proxy = stepFunction [ , ( 744 , 4) -- 744 entries at 4 bytes. ] where - firstEntry = case shelleyBasedEra @ era of + firstEntry = case shelleyBasedEra @era of ShelleyBasedEraShelley -> 37 ShelleyBasedEraAllegra -> 39 ShelleyBasedEraMary -> 39 @@ -128,11 +128,11 @@ dummyTxSizeInEra metadata = case createAndValidateTransactionBody dummyTx of } dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int -dummyTxSize _p m = (dummyTxSizeInEra @ era) $ metadataInEra m +dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era metadataInEra Nothing = TxMetadataNone -metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @ era) of +metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @era) of Nothing -> error "unreachable" Just e -> TxMetadataInEra e m @@ -143,7 +143,7 @@ mkMetadata size then Left $ "Error : metadata must be 0 or at least " ++ show minSize ++ " bytes in this era." else Right $ metadataInEra $ Just metadata where - minSize = case shelleyBasedEra @ era of + minSize = case shelleyBasedEra @era of ShelleyBasedEraShelley -> 37 ShelleyBasedEraAllegra -> 39 ShelleyBasedEraMary -> 39 diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index d6b4500b058..4d7b1ca8d32 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -186,7 +186,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = txToIdSize = (Mempool.txId &&& txInBlockSize) . toGenTx toGenTx :: tx -> GenTx CardanoBlock - toGenTx tx = case shelleyBasedEra @ era of + toGenTx tx = case shelleyBasedEra @era of ShelleyBasedEraShelley -> toConsensusGenTx $ TxInMode tx ShelleyEraInCardanoMode ShelleyBasedEraAllegra -> toConsensusGenTx $ TxInMode tx AllegraEraInCardanoMode ShelleyBasedEraMary -> toConsensusGenTx $ TxInMode tx MaryEraInCardanoMode diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 32edd9563c0..5a1eb6fd139 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -112,7 +112,7 @@ addFund era wallet txIn lovelace keyName = do fundKey <- getName keyName let mkOutValue :: forall era. IsShelleyBasedEra era => AsType era -> ActionM (InAnyCardanoEra TxOutValue) - mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @ era) (lovelaceToTxOutValue lovelace) + mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @era) (lovelaceToTxOutValue lovelace) outValue <- withEra era mkOutValue addFundToWallet wallet txIn outValue fundKey @@ -145,7 +145,7 @@ getConnectClient = do tracers <- get BenchTracers (Testnet networkMagic) <- getUser TNetworkId protocol <- get Protocol - void $ return $(btSubmission2_ tracers) + void $ return $ btSubmission2_ tracers -- TODO this line looks strange ioManager <- askIOManager return $ benchmarkConnectTxSubmit ioManager @@ -354,8 +354,8 @@ selectCollateralFunds (Just walletName) = do collateralFunds <- liftIO ( askWalletRef cw FundQueue.toList ) >>= \case [] -> throwE $ WalletError "selectCollateralFunds: emptylist" l -> return l - case collateralSupportedInEra (cardanoEra @ era) of - Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @ era) + case collateralSupportedInEra (cardanoEra @era) of + Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @era) Just p -> return (TxInsCollateral p $ map getFundTxIn collateralFunds, collateralFunds) dumpToFile :: FilePath -> TxInMode CardanoMode -> ActionM () @@ -375,7 +375,7 @@ interpretPayMode payMode = do fundKey <- getName keyName walletRef <- getName destWallet return ( createAndStore (mkUTxOVariant networkId fundKey) (mkWalletFundStore walletRef) - , Text.unpack $ serialiseAddress $ Utils.keyAddress @ era networkId fundKey) + , Text.unpack $ serialiseAddress $ Utils.keyAddress @era networkId fundKey) PayToScript scriptSpec destWallet -> do walletRef <- getName destWallet (witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec @@ -483,8 +483,8 @@ makePlutusContext scriptSpec = do PlutusScript PlutusScriptV1 script' = script scriptWitness :: ScriptWitness WitCtxTxIn era - scriptWitness = case scriptLanguageSupportedInEra (cardanoEra @ era) (PlutusScriptLanguage PlutusScriptV1) of - Nothing -> error $ "runPlutusBenchmark: Plutus V1 scriptlanguage not supported : in era" ++ show (cardanoEra @ era) + scriptWitness = case scriptLanguageSupportedInEra (cardanoEra @era) (PlutusScriptLanguage PlutusScriptV1) of + Nothing -> error $ "runPlutusBenchmark: Plutus V1 scriptlanguage not supported : in era" ++ show (cardanoEra @era) Just scriptLang -> PlutusScriptWitness scriptLang PlutusScriptV1 diff --git a/bench/tx-generator/test/Main.hs b/bench/tx-generator/test/Main.hs index 9f4336d482a..25575148f31 100644 --- a/bench/tx-generator/test/Main.hs +++ b/bench/tx-generator/test/Main.hs @@ -17,6 +17,7 @@ tests = testGroup "cardano-tx-generator" sizedMetadata ] +sizedMetadata :: TestTree sizedMetadata = testGroup "properties of the CBOR encoding relevant for generating sized metadat" [ testCase "Shelley metadata map costs" $ assertBool "metadata map costs" prop_mapCostsShelley , testCase "Shelley metadata ByteString costs" $ assertBool "metadata ByteString costs" prop_bsCostsShelley diff --git a/cardano-api/src/Cardano/Api/LedgerEvent.hs b/cardano-api/src/Cardano/Api/LedgerEvent.hs index 38926b871e4..9c883019f20 100644 --- a/cardano-api/src/Cardano/Api/LedgerEvent.hs +++ b/cardano-api/src/Cardano/Api/LedgerEvent.hs @@ -97,7 +97,7 @@ instance instance All ConvertLedgerEvent xs => ConvertLedgerEvent (HardForkBlock xs) where toLedgerEvent = hcollapse - . hcmap (Proxy @ ConvertLedgerEvent) (K . toLedgerEvent) + . hcmap (Proxy @ConvertLedgerEvent) (K . toLedgerEvent) . getOneEraLedgerEvent . unwrapLedgerEvent diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index afcce8df950..5abadb7303a 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -82,7 +82,7 @@ import Data.SOP.Strict (NP (..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Text.Lazy (toStrict) +import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder (toLazyText) import Data.Word import qualified Data.Yaml as Yaml @@ -1294,7 +1294,7 @@ instance Error LeadershipError where displayError LeaderErrDecodeLedgerStateFailure = "Failed to successfully decode ledger state" displayError (LeaderErrDecodeProtocolStateFailure (_, decErr)) = - "Failed to successfully decode protocol state: " <> Text.unpack (toStrict . toLazyText $ build decErr) + "Failed to successfully decode protocol state: " <> Text.unpack (LT.toStrict . toLazyText $ build decErr) displayError LeaderErrGenesisSlot = "Leadership schedule currently cannot be calculated from genesis" displayError (LeaderErrStakePoolHasNoStake poolId) = diff --git a/cardano-api/src/Cardano/Api/TxSubmit/ErrorRender.hs b/cardano-api/src/Cardano/Api/TxSubmit/ErrorRender.hs index 725f8323098..1afbfd92013 100644 --- a/cardano-api/src/Cardano/Api/TxSubmit/ErrorRender.hs +++ b/cardano-api/src/Cardano/Api/TxSubmit/ErrorRender.hs @@ -39,15 +39,15 @@ renderTxValidationError tve = "Tx Validation: " <> case tve of TxValidationLovelaceError txt e -> - sformat ("Lovelace error "% stext %": "% build) txt e + sformat ("Lovelace error " % stext % ": " % build) txt e TxValidationFeeTooSmall tx expected actual -> - sformat ("Tx "% build %" fee "% build %"too low, expected "% build) tx actual expected + sformat ("Tx " % build % " fee " % build % "too low, expected " % build) tx actual expected TxValidationWitnessWrongSignature wit pmid sig -> - sformat ("Bad witness "% build %" for signature "% stext %" protocol magic id "% stext) wit (textShow sig) (textShow pmid) + sformat ("Bad witness " % build % " for signature " % stext % " protocol magic id " % stext) wit (textShow sig) (textShow pmid) TxValidationWitnessWrongKey wit addr -> - sformat ("Bad witness "% build %" for address "% build) wit addr + sformat ("Bad witness " % build % " for address " % build) wit addr TxValidationMissingInput tx -> - sformat ("Validation cannot find input tx "% build) tx + sformat ("Validation cannot find input tx " % build) tx -- Fields are TxValidationNetworkMagicMismatch expected actual -> mconcat [ "Bad network magic ", textShow actual, ", expected ", textShow expected ] @@ -62,6 +62,6 @@ renderUTxOError :: UTxOError -> Text renderUTxOError ue = "UTxOError: " <> case ue of - UTxOMissingInput tx -> sformat ("Lookup of tx "% build %" failed") tx + UTxOMissingInput tx -> sformat ("Lookup of tx " % build % " failed") tx UTxOOverlappingUnion -> "Union or two overlapping UTxO sets" diff --git a/cardano-api/src/Cardano/Api/TxSubmit/Types.hs b/cardano-api/src/Cardano/Api/TxSubmit/Types.hs index 05ec0881b29..821ad85fa66 100644 --- a/cardano-api/src/Cardano/Api/TxSubmit/Types.hs +++ b/cardano-api/src/Cardano/Api/TxSubmit/Types.hs @@ -56,7 +56,7 @@ convertJson st = renderTxSubmitStatus :: TxSubmitStatus -> Text renderTxSubmitStatus st = case st of - TxSubmitOk tx -> sformat ("Tx "% build %" submitted successfully") tx + TxSubmitOk tx -> sformat ("Tx " % build % " submitted successfully") tx TxSubmitDecodeHex -> "Provided data was hex encoded and this webapi expects raw binary" TxSubmitEmpty -> "Provided transaction has zero length" TxSubmitDecodeFail err -> sformat build err diff --git a/cardano-api/test/Test/Cardano/Api/Crypto.hs b/cardano-api/test/Test/Cardano/Api/Crypto.hs index 00bc7552f73..1a482e59976 100644 --- a/cardano-api/test/Test/Cardano/Api/Crypto.hs +++ b/cardano-api/test/Test/Cardano/Api/Crypto.hs @@ -69,13 +69,13 @@ testDSIGNAlgorithm _ n = , testGroup "size" [ testProperty "VerKey" $ prop_size_serialise @(VerKeyDSIGN v) rawSerialiseVerKeyDSIGN - (sizeVerKeyDSIGN (Proxy @ v)) + (sizeVerKeyDSIGN (Proxy @v)) , testProperty "SignKey" $ prop_size_serialise @(SignKeyDSIGN v) rawSerialiseSignKeyDSIGN - (sizeSignKeyDSIGN (Proxy @ v)) + (sizeSignKeyDSIGN (Proxy @v)) , testProperty "Sig" $ prop_size_serialise @(SigDSIGN v) rawSerialiseSigDSIGN - (sizeSigDSIGN (Proxy @ v)) + (sizeSigDSIGN (Proxy @v)) ] , testGroup "direct CBOR" diff --git a/cardano-cli/app/cardano-cli.hs b/cardano-cli/app/cardano-cli.hs index a103a8e4cce..f613c310ccc 100644 --- a/cardano-cli/app/cardano-cli.hs +++ b/cardano-cli/app/cardano-cli.hs @@ -5,7 +5,7 @@ #define UNIX #endif -import Cardano.Prelude hiding (option) +import Cardano.Prelude import Control.Monad.Trans.Except.Exit (orDie) import qualified Options.Applicative as Opt diff --git a/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs b/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs index f64ef3b24a8..7d812c096d6 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs @@ -12,7 +12,7 @@ module Cardano.CLI.Byron.Delegation ) where -import Cardano.Prelude hiding (option, show, trace) +import Cardano.Prelude hiding (show, trace) import Control.Monad.Trans.Except.Extra (left) import qualified Data.ByteString.Lazy as LB diff --git a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs index 79988b18ab2..0b79d1ef248 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs @@ -12,7 +12,7 @@ module Cardano.CLI.Byron.Genesis ) where -import Cardano.Prelude hiding (option, show, trace) +import Cardano.Prelude hiding (show, trace) import Prelude (String) import Control.Monad.Trans.Except.Extra (firstExceptT, left, right) @@ -23,6 +23,7 @@ import Data.Time (UTCTime) import Formatting.Buildable import Cardano.Api (Key (..), NetworkId, textShow, writeSecrets) + import Cardano.Api.Byron (ByronKey, SerialiseAsRawBytes (..), SigningKey (..), toByronRequiresNetworkMagic) import System.Directory (createDirectory, doesPathExist) diff --git a/cardano-cli/src/Cardano/CLI/Byron/Key.hs b/cardano-cli/src/Cardano/CLI/Byron/Key.hs index 03f484e818c..1db5bb4c997 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Key.hs @@ -14,7 +14,7 @@ module Cardano.CLI.Byron.Key ) where -import Cardano.Prelude hiding (option, show, trace, (%)) +import Cardano.Prelude hiding (show, trace, (%)) import Prelude (show) import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, @@ -70,9 +70,9 @@ newtype NewVerificationKeyFile = -- its hash and formatted view. prettyPublicKey :: VerificationKey ByronKey-> Text prettyPublicKey (ByronVerificationKey vk) = - sformat ( " public key hash: "% build % - "\npublic key (base64): "% Crypto.fullVerificationKeyF % - "\n public key (hex): "% Crypto.fullVerificationKeyHexF) + sformat ( " public key hash: " % build % + "\npublic key (base64): " % Crypto.fullVerificationKeyF % + "\n public key (hex): " % Crypto.fullVerificationKeyHexF) (Common.addressHash vk) vk vk byronWitnessToVerKey :: SomeByronSigningKey -> VerificationKey ByronKey diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs index d7364b58c05..a7951652e2e 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs @@ -21,7 +21,7 @@ module Cardano.CLI.Byron.Parsers , parseUpdateVoteThd ) where -import Cardano.Prelude hiding (option) +import Cardano.Prelude import Prelude (String) import Control.Monad (fail) @@ -114,7 +114,7 @@ pNodeCmdBackwardCompatible = Opt.subparser $ pNodeCmd <> Opt.internal parseCBORObject :: Parser CBORObject parseCBORObject = asum - [ CBORBlockByron <$> option auto + [ CBORBlockByron <$> Opt.option auto ( long "byron-block" <> help ( "The CBOR file is a byron era block." @@ -263,7 +263,7 @@ parseTestnetBalanceOptions = parseTxIn :: Parser TxIn parseTxIn = - option + Opt.option (readerFromAttoParser parseTxInAtto) $ long "txin" <> metavar "(TXID,INDEX)" @@ -287,7 +287,7 @@ parseTxIxAtto = toEnum <$> Atto.decimal parseTxOut :: Parser (TxOut CtxTx ByronEra) parseTxOut = - option + Opt.option ( (\(addr, lovelace) -> TxOut (pAddressInEra addr) (pLovelaceTxOut lovelace) TxOutDatumNone @@ -434,7 +434,7 @@ parseByronVote = parseScriptVersion :: Parser Word16 parseScriptVersion = - option auto + Opt.option auto ( long "script-version" <> metavar "WORD16" <> help "Proposed script version." @@ -442,14 +442,14 @@ parseScriptVersion = parseSlotDuration :: Parser Natural parseSlotDuration = - option auto + Opt.option auto ( long "slot-duration" <> metavar "NATURAL" <> help "Proposed slot duration." ) parseSystemTag :: Parser SystemTag -parseSystemTag = option (eitherReader checkSysTag) +parseSystemTag = Opt.option (eitherReader checkSysTag) ( long "system-tag" <> metavar "STRING" <> help "Identify which system (linux, win64, etc) the update proposal is for." @@ -472,7 +472,7 @@ parseInstallerHash = parseMaxBlockSize :: Parser Natural parseMaxBlockSize = - option auto + Opt.option auto ( long "max-block-size" <> metavar "NATURAL" <> help "Proposed max block size." @@ -480,7 +480,7 @@ parseMaxBlockSize = parseMaxHeaderSize :: Parser Natural parseMaxHeaderSize = - option auto + Opt.option auto ( long "max-header-size" <> metavar "NATURAL" <> help "Proposed max block header size." @@ -488,7 +488,7 @@ parseMaxHeaderSize = parseMaxTxSize :: Parser Natural parseMaxTxSize = - option auto + Opt.option auto ( long "max-tx-size" <> metavar "NATURAL" <> help "Proposed max transaction size." @@ -496,7 +496,7 @@ parseMaxTxSize = parseMaxProposalSize :: Parser Natural parseMaxProposalSize = - option auto + Opt.option auto ( long "max-proposal-size" <> metavar "NATURAL" <> help "Proposed max update proposal size." @@ -531,7 +531,7 @@ parseUpdateProposalThd = parseUpdateProposalTTL :: Parser SlotNumber parseUpdateProposalTTL = SlotNumber - <$> option auto + <$> Opt.option auto ( long "time-to-live" <> metavar "WORD64" <> help "Proposed time for an update proposal to live." @@ -550,7 +550,7 @@ parseSoftwareVersion = SoftwareVersion <$> parseApplicationName <*> parseNumSoftwareVersion parseApplicationName :: Parser ApplicationName -parseApplicationName = option (eitherReader checkAppNameLength) +parseApplicationName = Opt.option (eitherReader checkAppNameLength) ( long "application-name" <> metavar "STRING" <> help "The name of the application." @@ -584,7 +584,7 @@ parseVoteBool = flag' True (long "vote-yes" <> help "Vote yes with respect to an parseUnlockStakeEpoch :: Parser EpochNumber parseUnlockStakeEpoch = EpochNumber - <$> option auto + <$> Opt.option auto ( long "unlock-stake-epoch" <> metavar "WORD64" <> help "Proposed epoch to unlock all stake." @@ -592,14 +592,14 @@ parseUnlockStakeEpoch = parseWord :: Integral a => String -> String -> String -> Parser a -parseWord optname desc metvar = option (fromInteger <$> auto) +parseWord optname desc metvar = Opt.option (fromInteger <$> auto) $ long optname <> metavar metvar <> help desc parseAddress :: String -> String -> Parser (Address ByronAddr) parseAddress opt desc = - option (cliParseBase58Address <$> str) + Opt.option (cliParseBase58Address <$> str) $ long opt <> metavar "ADDR" <> help desc parseByronKeyFormat :: Parser ByronKeyFormat @@ -641,7 +641,7 @@ parseFractionWithDefault -> Double -> Parser Rational parseFractionWithDefault optname desc w = - toRational <$> option readDouble + toRational <$> Opt.option readDouble ( long optname <> metavar "DOUBLE" <> help desc @@ -700,7 +700,7 @@ parseTxFile opt = parseUTCTime :: String -> String -> Parser UTCTime parseUTCTime optname desc = - option (posixSecondsToUTCTime . fromInteger <$> auto) + Opt.option (posixSecondsToUTCTime . fromInteger <$> auto) $ long optname <> metavar "POSIXSECONDS" <> help desc cliParseBase58Address :: Text -> Address ByronAddr @@ -711,13 +711,13 @@ cliParseBase58Address t = parseFraction :: String -> String -> Parser Rational parseFraction optname desc = - option (toRational <$> readDouble) $ + Opt.option (toRational <$> readDouble) $ long optname <> metavar "DOUBLE" <> help desc parseIntegral :: Integral a => String -> String -> Parser a -parseIntegral optname desc = option (fromInteger <$> auto) +parseIntegral optname desc = Opt.option (fromInteger <$> auto) $ long optname <> metavar "INT" <> help desc parseLovelace :: String -> String -> Parser Byron.Lovelace diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 364cd58b6ea..40cb506d931 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -22,7 +22,7 @@ module Cardano.CLI.Byron.Tx ) where -import Cardano.Prelude hiding (option, trace, (%)) +import Cardano.Prelude hiding (trace, (%)) import Prelude (error) import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT) @@ -78,7 +78,7 @@ newtype NewTxFile = -- its full structure. prettyAddress :: Address ByronAddr -> Text prettyAddress (ByronAddress addr) = sformat - (Common.addressF %"\n"%Common.addressDetailedF) + (Common.addressF % "\n" % Common.addressDetailedF) addr addr readByronTx :: TxFile -> ExceptT ByronTxError IO (UTxO.ATxAux ByteString) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index e908d8a7056..ef93403fdfc 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -14,7 +14,7 @@ module Cardano.CLI.Shelley.Parsers , parseTxIn ) where -import Cardano.Prelude hiding (All, Any, option) +import Cardano.Prelude hiding (All, Any) import Prelude (String) import Control.Monad.Fail (fail) diff --git a/cardano-node-chairman/app/Cardano/Chairman.hs b/cardano-node-chairman/app/Cardano/Chairman.hs index 8f6fc80266b..d3d8c5adce6 100644 --- a/cardano-node-chairman/app/Cardano/Chairman.hs +++ b/cardano-node-chairman/app/Cardano/Chairman.hs @@ -11,7 +11,7 @@ module Cardano.Chairman (chairmanTest) where -import Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show, throwIO) +import Cardano.Prelude hiding (ByteString, STM, atomically, catch, show, throwIO) import Prelude (String, error, show) import Control.Monad.Class.MonadAsync diff --git a/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs b/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs index 78166a00f5c..b9da33986cf 100644 --- a/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs +++ b/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs @@ -7,13 +7,14 @@ module Cardano.Chairman.Commands.Run ( cmdRun ) where -import Cardano.Prelude hiding (option) +import Cardano.Prelude import Control.Monad.Class.MonadTime (DiffTime) import Control.Tracer (Tracer (..), stdoutTracer) import qualified Data.Text as Text import qualified Data.Time.Clock as DTC import Options.Applicative +import qualified Options.Applicative as Opt import qualified System.IO as IO import Cardano.Node.Configuration.NodeAddress @@ -63,7 +64,7 @@ parseSocketPath helpMessage = parseRunningTime :: Parser DiffTime parseRunningTime = - option ((fromIntegral :: Int -> DiffTime) <$> auto) + Opt.option ((fromIntegral :: Int -> DiffTime) <$> auto) ( long "timeout" <> short 't' <> metavar "SECONDS" @@ -72,7 +73,7 @@ parseRunningTime = parseProgress :: Parser BlockNo parseProgress = - option ((fromIntegral :: Int -> BlockNo) <$> auto) + Opt.option ((fromIntegral :: Int -> BlockNo) <$> auto) ( long "require-progress" <> short 'p' <> metavar "INT" diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index 9da9009edbb..f9354dc3462 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -import Cardano.Prelude hiding (option) +import Cardano.Prelude import qualified Data.Text as Text import Prelude (String) diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 55b998e59ff..51df5b31807 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -11,7 +11,7 @@ module Cardano.Node.Parsers , renderHelpDoc ) where -import Cardano.Prelude hiding (option) +import Cardano.Prelude import Prelude (String) import Data.Time.Clock (secondsToDiffTime) @@ -141,7 +141,7 @@ parseTracerSocketMode = parseHostIPv4Addr :: Parser NodeHostIPv4Address parseHostIPv4Addr = - option (eitherReader parseNodeHostIPv4Address) ( + Opt.option (eitherReader parseNodeHostIPv4Address) ( long "host-addr" <> metavar "IPV4" <> help "An optional IPv4 address" @@ -149,7 +149,7 @@ parseHostIPv4Addr = parseHostIPv6Addr :: Parser NodeHostIPv6Address parseHostIPv6Addr = - option (eitherReader parseNodeHostIPv6Address) ( + Opt.option (eitherReader parseNodeHostIPv6Address) ( long "host-ipv6-addr" <> metavar "IPV6" <> help "An optional IPv6 address" @@ -175,7 +175,7 @@ parseNodeHostIPv6Address str = parsePort :: Parser PortNumber parsePort = - option ((fromIntegral :: Int -> PortNumber) <$> auto) ( + Opt.option ((fromIntegral :: Int -> PortNumber) <$> auto) ( long "port" <> metavar "PORT" <> help "The port number" @@ -197,7 +197,7 @@ parseMempoolCapacityOverride = parseOverride <|> parseNoOverride parseOverride :: Parser MempoolCapacityBytesOverride parseOverride = MempoolCapacityBytesOverride . MempoolCapacityBytes <$> - option (auto @Word32) + Opt.option (auto @Word32) ( long "mempool-capacity-override" <> metavar "BYTES" <> help "The number of bytes" @@ -227,7 +227,7 @@ parseValidateDB = parseShutdownIPC :: Parser Fd parseShutdownIPC = - option (Fd <$> auto) ( + Opt.option (Fd <$> auto) ( long "shutdown-ipc" <> metavar "FD" <> help "Shut down the process when this inherited FD reaches EOF" @@ -309,7 +309,7 @@ parseVrfKeyFilePath = parseSnapshotInterval :: Parser SnapshotInterval parseSnapshotInterval = fmap (RequestedSnapshotInterval . secondsToDiffTime) parseDifftime where - parseDifftime = option auto + parseDifftime = Opt.option auto ( long "snapshot-interval" <> metavar "SNAPSHOTINTERVAL" <> help "Snapshot Interval (in second)" diff --git a/cardano-node/src/Cardano/Node/Queries.hs b/cardano-node/src/Cardano/Node/Queries.hs index 2db5824500c..9a084408194 100644 --- a/cardano-node/src/Cardano/Node/Queries.hs +++ b/cardano-node/src/Cardano/Node/Queries.hs @@ -106,7 +106,7 @@ instance All ConvertTxId xs => ConvertTxId (HardForkBlock xs) where txIdToRawBytes = hcollapse - . hcmap (Proxy @ ConvertTxId) (K . txIdToRawBytes . unwrapGenTxId) + . hcmap (Proxy @ConvertTxId) (K . txIdToRawBytes . unwrapGenTxId) . getOneEraGenTxId . getHardForkGenTxId diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs index 0a138e060eb..c9068248628 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs @@ -55,7 +55,7 @@ import Ouroboros.Consensus.Util.Condense (Condense (..)) instance All (LogFormatting `Compose` Header) xs => LogFormatting (Header (HardForkBlock xs)) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` Header)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` Header)) (K . forMachine dtal) . getOneEraHeader . getHardForkHeader @@ -67,7 +67,7 @@ instance All (LogFormatting `Compose` Header) xs => LogFormatting (Header (HardF instance All (Compose LogFormatting GenTx) xs => LogFormatting (GenTx (HardForkBlock xs)) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` GenTx)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` GenTx)) (K . forMachine dtal) . getOneEraGenTx . getHardForkGenTx @@ -90,7 +90,7 @@ instance All (LogFormatting `Compose` WrapApplyTxErr) xs => LogFormatting (HardF instance All (LogFormatting `Compose` WrapApplyTxErr) xs => LogFormatting (OneEraApplyTxErr xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapApplyTxErr)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` WrapApplyTxErr)) (K . forMachine dtal) . getOneEraApplyTxErr instance LogFormatting (ApplyTxErr blk) => LogFormatting (WrapApplyTxErr blk) where @@ -116,7 +116,7 @@ instance All (LogFormatting `Compose` WrapLedgerErr) xs => LogFormatting (HardFo instance All (LogFormatting `Compose` WrapLedgerErr) xs => LogFormatting (OneEraLedgerError xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapLedgerErr)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` WrapLedgerErr)) (K . forMachine dtal) . getOneEraLedgerError instance LogFormatting (LedgerError blk) => LogFormatting (WrapLedgerErr blk) where @@ -166,7 +166,7 @@ instance ( All (LogFormatting `Compose` WrapLedgerWarning) xs instance All (LogFormatting `Compose` WrapLedgerWarning) xs => LogFormatting (OneEraLedgerWarning xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapLedgerWarning)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` WrapLedgerWarning)) (K . forMachine dtal) . getOneEraLedgerWarning instance LogFormatting (LedgerWarning blk) => LogFormatting (WrapLedgerWarning blk) where @@ -219,7 +219,7 @@ instance ( All (LogFormatting `Compose` WrapLedgerUpdate) xs instance All (LogFormatting `Compose` WrapLedgerUpdate) xs => LogFormatting (OneEraLedgerUpdate xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapLedgerUpdate)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` WrapLedgerUpdate)) (K . forMachine dtal) . getOneEraLedgerUpdate instance LogFormatting (LedgerUpdate blk) => LogFormatting (WrapLedgerUpdate blk) where @@ -245,7 +245,7 @@ instance All (LogFormatting `Compose` WrapEnvelopeErr) xs => LogFormatting (Hard instance All (LogFormatting `Compose` WrapEnvelopeErr) xs => LogFormatting (OneEraEnvelopeErr xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapEnvelopeErr)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` WrapEnvelopeErr)) (K . forMachine dtal) . getOneEraEnvelopeErr instance LogFormatting (OtherHeaderEnvelopeError blk) => LogFormatting (WrapEnvelopeErr blk) where @@ -271,7 +271,7 @@ instance All (LogFormatting `Compose` WrapValidationErr) xs => LogFormatting (Ha instance All (LogFormatting `Compose` WrapValidationErr) xs => LogFormatting (OneEraValidationErr xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapValidationErr)) (K . forMachine dtal) + . hcmap (Proxy @(LogFormatting `Compose` WrapValidationErr)) (K . forMachine dtal) . getOneEraValidationErr instance LogFormatting (ValidationErr (BlockProtocol blk)) => LogFormatting (WrapValidationErr blk) where @@ -288,7 +288,7 @@ instance LogFormatting (ValidationErr (BlockProtocol blk)) => LogFormatting (Wra instance All (LogFormatting `Compose` WrapCannotForge) xs => LogFormatting (OneEraCannotForge xs) where forMachine dtal = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapCannotForge)) + . hcmap (Proxy @(LogFormatting `Compose` WrapCannotForge)) (K . forMachine dtal) . getOneEraCannotForge @@ -313,7 +313,7 @@ instance All (LogFormatting `Compose` WrapForgeStateInfo) xs => LogFormatting (O forgeStateInfo' :: Object forgeStateInfo' = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapForgeStateInfo)) + . hcmap (Proxy @(LogFormatting `Compose` WrapForgeStateInfo)) (K . forMachine dtal) . getOneEraForgeStateInfo $ forgeStateInfo @@ -339,7 +339,7 @@ instance All (LogFormatting `Compose` WrapForgeStateUpdateError) xs => LogFormat forgeStateUpdateError' :: Object forgeStateUpdateError' = hcollapse - . hcmap (Proxy @ (LogFormatting `Compose` WrapForgeStateUpdateError)) + . hcmap (Proxy @(LogFormatting `Compose` WrapForgeStateUpdateError)) (K . forMachine dtal) . getOneEraForgeStateUpdateError $ forgeStateUpdateError diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Common.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Common.hs index eae3e2e6398..26496b9c58b 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Common.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Common.hs @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -82,7 +83,7 @@ instance FromJSON TracingVerbosity where <> "Encountered: " <> show invalid instance FromJSON PortNumber where - parseJSON (Number portNum) = case readMaybe . show $ coefficient portNum of + parseJSON (Number portNum) = case readMaybe . show @Integer $ coefficient portNum of Just port -> pure port Nothing -> fail $ show portNum <> " is not a valid port number." parseJSON invalid = fail $ "Parsing of port number failed due to type mismatch. " diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 0ca9e2adf6b..4f49c371a3f 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -63,7 +63,7 @@ instance Condense (OneEraHash xs) where instance All (ToObject `Compose` Header) xs => ToObject (Header (HardForkBlock xs)) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` Header)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` Header)) (K . toObject verb) . getOneEraHeader . getHardForkHeader @@ -75,14 +75,14 @@ instance All (ToObject `Compose` Header) xs => ToObject (Header (HardForkBlock x instance All (Compose ToObject GenTx) xs => ToObject (GenTx (HardForkBlock xs)) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` GenTx)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` GenTx)) (K . toObject verb) . getOneEraGenTx . getHardForkGenTx instance All (Compose ToJSON WrapGenTxId) xs => ToJSON (TxId (GenTx (HardForkBlock xs))) where toJSON = hcollapse - . hcmap (Proxy @ (ToJSON `Compose` WrapGenTxId)) (K . toJSON) + . hcmap (Proxy @(ToJSON `Compose` WrapGenTxId)) (K . toJSON) . getOneEraGenTxId . getHardForkGenTxId @@ -108,7 +108,7 @@ instance All (ToObject `Compose` WrapApplyTxErr) xs => ToObject (HardForkApplyTx instance All (ToObject `Compose` WrapApplyTxErr) xs => ToObject (OneEraApplyTxErr xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapApplyTxErr)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` WrapApplyTxErr)) (K . toObject verb) . getOneEraApplyTxErr instance ToObject (ApplyTxErr blk) => ToObject (WrapApplyTxErr blk) where @@ -134,7 +134,7 @@ instance All (ToObject `Compose` WrapLedgerErr) xs => ToObject (HardForkLedgerEr instance All (ToObject `Compose` WrapLedgerErr) xs => ToObject (OneEraLedgerError xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapLedgerErr)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` WrapLedgerErr)) (K . toObject verb) . getOneEraLedgerError instance ToObject (LedgerError blk) => ToObject (WrapLedgerErr blk) where @@ -184,7 +184,7 @@ instance ( All (ToObject `Compose` WrapLedgerWarning) xs instance All (ToObject `Compose` WrapLedgerWarning) xs => ToObject (OneEraLedgerWarning xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapLedgerWarning)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` WrapLedgerWarning)) (K . toObject verb) . getOneEraLedgerWarning instance ToObject (LedgerWarning blk) => ToObject (WrapLedgerWarning blk) where @@ -237,7 +237,7 @@ instance ( All (ToObject `Compose` WrapLedgerUpdate) xs instance All (ToObject `Compose` WrapLedgerUpdate) xs => ToObject (OneEraLedgerUpdate xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapLedgerUpdate)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` WrapLedgerUpdate)) (K . toObject verb) . getOneEraLedgerUpdate instance ToObject (LedgerUpdate blk) => ToObject (WrapLedgerUpdate blk) where @@ -263,7 +263,7 @@ instance All (ToObject `Compose` WrapEnvelopeErr) xs => ToObject (HardForkEnvelo instance All (ToObject `Compose` WrapEnvelopeErr) xs => ToObject (OneEraEnvelopeErr xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapEnvelopeErr)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` WrapEnvelopeErr)) (K . toObject verb) . getOneEraEnvelopeErr instance ToObject (OtherHeaderEnvelopeError blk) => ToObject (WrapEnvelopeErr blk) where @@ -289,7 +289,7 @@ instance All (ToObject `Compose` WrapValidationErr) xs => ToObject (HardForkVali instance All (ToObject `Compose` WrapValidationErr) xs => ToObject (OneEraValidationErr xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapValidationErr)) (K . toObject verb) + . hcmap (Proxy @(ToObject `Compose` WrapValidationErr)) (K . toObject verb) . getOneEraValidationErr instance ToObject (ValidationErr (BlockProtocol blk)) => ToObject (WrapValidationErr blk) where @@ -306,7 +306,7 @@ instance ToObject (ValidationErr (BlockProtocol blk)) => ToObject (WrapValidatio instance All (ToObject `Compose` WrapCannotForge) xs => ToObject (OneEraCannotForge xs) where toObject verb = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapCannotForge)) + . hcmap (Proxy @(ToObject `Compose` WrapCannotForge)) (K . toObject verb) . getOneEraCannotForge @@ -331,7 +331,7 @@ instance All (ToObject `Compose` WrapForgeStateInfo) xs => ToObject (OneEraForge forgeStateInfo' :: Object forgeStateInfo' = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapForgeStateInfo)) + . hcmap (Proxy @(ToObject `Compose` WrapForgeStateInfo)) (K . toObject verb) . getOneEraForgeStateInfo $ forgeStateInfo @@ -357,7 +357,7 @@ instance All (ToObject `Compose` WrapForgeStateUpdateError) xs => ToObject (OneE forgeStateUpdateError' :: Object forgeStateUpdateError' = hcollapse - . hcmap (Proxy @ (ToObject `Compose` WrapForgeStateUpdateError)) + . hcmap (Proxy @(ToObject `Compose` WrapForgeStateUpdateError)) (K . toObject verb) . getOneEraForgeStateUpdateError $ forgeStateUpdateError diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 5ba1f507dd2..548a301c56b 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -680,7 +680,7 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do tLocalUp tMaxSlotNo $ tracerOnOff (traceBlockFetchServer trSel) verb "BlockFetchServer" tr , Consensus.keepAliveClientTracer = tracerOnOff (traceKeepAliveClient trSel) verb "KeepAliveClient" tr , Consensus.forgeStateInfoTracer = tracerOnOff' (traceForgeStateInfo trSel) $ - forgeStateInfoTracer (Proxy @ blk) trSel tr + forgeStateInfoTracer (Proxy @blk) trSel tr , Consensus.txInboundTracer = tracerOnOff' (traceTxInbound trSel) $ Tracer $ \ev -> do traceWith (annotateSeverity . toLogObject' verb $ appendName "TxInbound" tr) ev diff --git a/cardano-submit-api/src/Cardano/TxSubmit/ErrorRender.hs b/cardano-submit-api/src/Cardano/TxSubmit/ErrorRender.hs index 0b72fa0ede5..d025d15801c 100644 --- a/cardano-submit-api/src/Cardano/TxSubmit/ErrorRender.hs +++ b/cardano-submit-api/src/Cardano/TxSubmit/ErrorRender.hs @@ -40,15 +40,15 @@ renderTxValidationError tve = "Tx Validation: " <> case tve of TxValidationLovelaceError txt e -> - sformat ("Lovelace error "% stext %": "% build) txt e + sformat ("Lovelace error " % stext % ": " % build) txt e TxValidationFeeTooSmall tx expected actual -> - sformat ("Tx "% build %" fee "% build %"too low, expected "% build) tx actual expected + sformat ("Tx " % build % " fee " % build % "too low, expected " % build) tx actual expected TxValidationWitnessWrongSignature wit pmid sig -> - sformat ("Bad witness "% build %" for signature "% stext %" protocol magic id "% stext) wit (textShow sig) (textShow pmid) + sformat ("Bad witness " % build % " for signature " % stext % " protocol magic id " % stext) wit (textShow sig) (textShow pmid) TxValidationWitnessWrongKey wit addr -> - sformat ("Bad witness "% build %" for address "% build) wit addr + sformat ("Bad witness " % build % " for address " % build) wit addr TxValidationMissingInput tx -> - sformat ("Validation cannot find input tx "% build) tx + sformat ("Validation cannot find input tx " % build) tx -- Fields are TxValidationNetworkMagicMismatch expected actual -> mconcat [ "Bad network magic ", textShow actual, ", expected ", textShow expected ] @@ -63,7 +63,7 @@ renderUTxOError :: UTxOError -> Text renderUTxOError ue = "UTxOError: " <> case ue of - UTxOMissingInput tx -> sformat ("Lookup of tx "% build %" failed") tx + UTxOMissingInput tx -> sformat ("Lookup of tx " % build % " failed") tx UTxOOverlappingUnion -> "Union or two overlapping UTxO sets" renderEraMismatch :: EraMismatch -> Text diff --git a/trace-dispatcher/src/Cardano/Logging/Configuration.hs b/trace-dispatcher/src/Cardano/Logging/Configuration.hs index 04bf0d5bd2b..8fd53314f6c 100644 --- a/trace-dispatcher/src/Cardano/Logging/Configuration.hs +++ b/trace-dispatcher/src/Cardano/Logging/Configuration.hs @@ -96,7 +96,7 @@ withNamespaceConfig name extract withConfig tr = do T.traceWith (unpackTrace tt) (lc, Left Reset) mkTrace ref (lc, Left (Config c)) = do - ! val <- extract c (lcNamespace lc) + !val <- extract c (lcNamespace lc) eitherConf <- liftIO $ readIORef ref case eitherConf of Left (cmap, Nothing) -> diff --git a/trace-dispatcher/src/Cardano/Logging/Trace.hs b/trace-dispatcher/src/Cardano/Logging/Trace.hs index 5db73042570..dde8c38abbb 100644 --- a/trace-dispatcher/src/Cardano/Logging/Trace.hs +++ b/trace-dispatcher/src/Cardano/Logging/Trace.hs @@ -232,7 +232,7 @@ foldTraceM cata initial (Trace tr) = do \case (lc, Right v) -> do x' <- modifyMVar ref $ \x -> - let ! accu = cata x lc v + let !accu = cata x lc v in pure (accu,accu) T.traceWith tr (lc, Right (Folding x')) (lc, Left control) -> do @@ -256,7 +256,7 @@ foldMTraceM cata initial (Trace tr) = do \case (lc, Right v) -> do x' <- modifyMVar ref $ \x -> do - ! accu <- cata x lc v + !accu <- cata x lc v pure $ join (,) accu T.traceWith tr (lc, Right (Folding x')) (lc, Left control) -> do @@ -279,7 +279,7 @@ foldMCondTraceM cata initial flt (Trace tr) = do \case (lc, Right v) -> do x' <- modifyMVar ref $ \x -> do - ! accu <- cata x lc v + !accu <- cata x lc v pure $ join (,) accu when (flt v) $ T.traceWith tr (lc, Right (Folding x')) diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs index 3f6a5aeaca6..8942c0679a4 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs @@ -9,7 +9,7 @@ module Cardano.Logging.Tracer.Composed ( , documentTracer ) where -import Control.Exception (catch, SomeException) +import Control.Exception (SomeException, catch) import Data.Aeson.Types (ToJSON) import Data.Maybe (fromMaybe) import Data.Text @@ -24,6 +24,7 @@ import Cardano.Logging.Trace import Cardano.Logging.Types import qualified Control.Tracer as NT +import qualified Data.List as L data MessageOrLimit m = Message m | Limit LimitingMessage @@ -111,17 +112,17 @@ mkCardanoTracer' trStdout trForward mbTrEkg tracerName namesFor severityFor priv [EKGBackend, Forwarder, Stdout HumanFormatColoured] mbBackends in do - mbForwardTrace <- if Forwarder `elem` backends' + mbForwardTrace <- if Forwarder `L.elem` backends' then fmap (Just . filterTraceByPrivacy (Just Public)) (forwardFormatter Nothing trForward) else pure Nothing - mbStdoutTrace <- if Stdout HumanFormatColoured `elem` backends' + mbStdoutTrace <- if Stdout HumanFormatColoured `L.elem` backends' then fmap Just (humanFormatter True Nothing trStdout) - else if Stdout HumanFormatUncoloured `elem` backends' + else if Stdout HumanFormatUncoloured `L.elem` backends' then fmap Just (humanFormatter False Nothing trStdout) - else if Stdout MachineFormat `elem` backends' + else if Stdout MachineFormat `L.elem` backends' then fmap Just (machineFormatter Nothing trStdout) else pure Nothing diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 0cd22abc14b..378ac0e088c 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -388,15 +388,15 @@ data TraceControl where newtype DocCollector = DocCollector (IORef (Map Int LogDoc)) data LogDoc = LogDoc { - ldDoc :: ! Text - , ldMetricsDoc :: ! (SMap.Map Text Text) - , ldNamespace :: ! [Namespace] - , ldSeverity :: ! [SeverityS] - , ldPrivacy :: ! [Privacy] - , ldDetails :: ! [DetailLevel] - , ldBackends :: ! [BackendConfig] - , ldFiltered :: ! [SeverityF] - , ldLimiter :: ! [(Text, Double)] + ldDoc :: !Text + , ldMetricsDoc :: !(SMap.Map Text Text) + , ldNamespace :: ![Namespace] + , ldSeverity :: ![SeverityS] + , ldPrivacy :: ![Privacy] + , ldDetails :: ![DetailLevel] + , ldBackends :: ![BackendConfig] + , ldFiltered :: ![SeverityF] + , ldLimiter :: ![(Text, Double)] } deriving(Eq, Show) emptyLogDoc :: Text -> [(Text, Text)] -> LogDoc From e6abec53e0a4dc6daf126bebc1c3065be6677a6b Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 4 Oct 2022 23:22:27 +1100 Subject: [PATCH 2/3] Remove unused constraints --- cardano-api/src/Cardano/Api/Query.hs | 3 +-- .../src/Cardano/Node/Tracing/Tracers/Consensus.hs | 3 +-- .../Cardano/Node/Tracing/Tracers/NodeToNode.hs | 6 ++---- .../Cardano/Tracing/OrphanInstances/Consensus.hs | 15 +++++---------- .../Cardano/Tracing/OrphanInstances/Shelley.hs | 1 - .../src/Cardano/Logging/FrequencyLimiter.hs | 2 +- 6 files changed, 10 insertions(+), 20 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index da103745186..91269192da0 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -292,7 +292,7 @@ instance IsCardanoEra era => ToJSON (UTxO era) where toJSON (UTxO m) = toJSON m toEncoding (UTxO m) = toEncoding m -instance (IsCardanoEra era, IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era)) +instance (IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era)) => FromJSON (UTxO era) where parseJSON = withObject "UTxO" $ \hm -> do let l = HMS.toList $ KeyMap.toHashMapText hm @@ -381,7 +381,6 @@ newtype CurrentEpochState era = CurrentEpochState (Shelley.EpochState (ShelleyLe decodeCurrentEpochState :: forall era. Ledger.Era (ShelleyLedgerEra era) - => Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Credential 'Shelley.Staking (Ledger.Crypto (ShelleyLedgerEra era))) => FromSharedCBOR (Core.TxOut (ShelleyLedgerEra era)) => Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Credential 'Shelley.Staking (Ledger.Crypto (ShelleyLedgerEra era))) => FromCBOR (Core.PParams (ShelleyLedgerEra era)) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 35188164474..08d9c92139d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -942,8 +942,7 @@ namesForMempool TraceMempoolRemoveTxs {} = ["RemoveTxs"] namesForMempool TraceMempoolManuallyRemovedTxs {} = ["ManuallyRemovedTxs"] instance - ( Show (ApplyTxErr blk) - , LogFormatting (ApplyTxErr blk) + ( LogFormatting (ApplyTxErr blk) , LogFormatting (GenTx blk) , ToJSON (GenTxId blk) , LedgerSupportsMempool blk diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index fe642a390ec..0d6870c8b4b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -42,8 +42,8 @@ import Text.Show import Cardano.Node.Queries (ConvertTxId) import Cardano.Node.Tracing.Render (renderHeaderHash, renderTxIdForDetails) -import Ouroboros.Consensus.Block (ConvertRawHash, GetHeader, HasHeader, Header, - StandardHash, getHeader) +import Ouroboros.Consensus.Block (ConvertRawHash, GetHeader, Header, StandardHash, + getHeader) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId, HasTxId, HasTxs, LedgerSupportsMempool, extractTxs, txId) import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize) @@ -189,8 +189,6 @@ namesForTBlockFetch (BlockFetch.TraceLabelPeer _ v) = namesTBlockFetch v namesTBlockFetch'' MsgClientDone {} = ["ClientDone"] instance ( ConvertTxId blk - , ConvertRawHash blk - , HasHeader blk , GetHeader blk , HasTxId (GenTx blk) , SerialiseNodeToNodeConstraints blk diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index ac40b417d72..3b69a78b999 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -48,8 +48,8 @@ import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMe import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..)) -import Ouroboros.Consensus.MiniProtocol.ChainSync.Server - (BlockingType (..), TraceChainSyncServerEvent (..)) +import Ouroboros.Consensus.MiniProtocol.ChainSync.Server (BlockingType (..), + TraceChainSyncServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server (TraceLocalTxSubmissionServerEvent (..)) import Ouroboros.Consensus.Node.Run (RunNode, estimateBlockSize) @@ -297,7 +297,7 @@ instance ConvertRawHash blk trTransformer = trStructured -instance ( ToObject (ApplyTxErr blk), Show (ApplyTxErr blk), ToObject (GenTx blk), +instance ( ToObject (ApplyTxErr blk), ToObject (GenTx blk), ToJSON (GenTxId blk), LedgerSupportsMempool blk) => Transformable Text IO (TraceEventMempool blk) where trTransformer = trStructured @@ -319,7 +319,6 @@ showT = pack . show instance ( tx ~ GenTx blk , HasTxId tx , RunNode blk - , Show (TxId tx) , ToObject (LedgerError blk) , ToObject (OtherHeaderEnvelopeError blk) , ToObject (ValidationErr (BlockProtocol blk)) @@ -1262,7 +1261,7 @@ instance ConvertRawHash blk ] <> [ "risingEdge" .= True | RisingEdge <- [enclosing] ] -instance ( Show (ApplyTxErr blk), ToObject (ApplyTxErr blk), ToObject (GenTx blk), +instance ( ToObject (ApplyTxErr blk), ToObject (GenTx blk), ToJSON (GenTxId blk), LedgerSupportsMempool blk ) => ToObject (TraceEventMempool blk) where toObject verb (TraceMempoolAddedTx tx _mpSzBefore mpSzAfter) = @@ -1306,11 +1305,7 @@ instance HasTextFormatter () where instance Transformable Text IO () where trTransformer = trStructuredText -instance ( tx ~ GenTx blk - , ConvertRawHash blk - , HasTxId tx - , RunNode blk - , Show (TxId tx) +instance ( RunNode blk , ToObject (LedgerError blk) , ToObject (OtherHeaderEnvelopeError blk) , ToObject (ValidationErr (BlockProtocol blk)) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index dd294fbafda..e6b166913f9 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -879,7 +879,6 @@ instance ToObject (UpecPredicateFailure era) where instance ( Ledger.Era era , ToJSON (Ledger.Value era) - , Show (Ledger.Value era) , ToJSON (Ledger.TxOut era) , ToObject (PredicateFailure (Ledger.EraRule "UTXOS" era)) , ShelleyBasedEra era diff --git a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs index 239c816a1ba..aebc967b949 100644 --- a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs +++ b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs @@ -109,7 +109,7 @@ data FrequencyRec a = FrequencyRec { limitFrequency - :: forall a m . (MonadIO m, MonadUnliftIO m) + :: forall a m . MonadUnliftIO m => Double -- messages per second -> Text -- name of this limiter -> Trace m a -- the limited trace From 969bc78e963ad66fa81db3095b2be0fb28d6ac93 Mon Sep 17 00:00:00 2001 From: John Ky Date: Wed, 5 Oct 2022 00:02:26 +1100 Subject: [PATCH 3/3] Remove unused dependencies --- cardano-api/cardano-api.cabal | 2 -- cardano-cli/cardano-cli.cabal | 1 - cardano-node-chairman/cardano-node-chairman.cabal | 1 - cardano-node/cardano-node.cabal | 2 -- cardano-testnet/cardano-testnet.cabal | 1 - cardano-tracer/cardano-tracer.cabal | 2 -- 6 files changed, 9 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 6264baa497a..b3a614f9963 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -201,10 +201,8 @@ test-suite cardano-api-test type: exitcode-stdio-1.0 build-depends: aeson >= 1.5.6.0 - , bytestring , cardano-api , cardano-api:gen - , cardano-binary , cardano-data , cardano-crypto , cardano-crypto-class diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 849697dc899..8d5bb7e1099 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -171,7 +171,6 @@ test-suite cardano-cli-test build-depends: aeson , bech32 >= 1.1.0 - , bytestring , base16-bytestring , cardano-api , cardano-api:gen diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 36b8c53abea..08541fe889c 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -40,7 +40,6 @@ executable cardano-node-chairman "-with-rtsopts=-T" build-depends: cardano-api , cardano-git-rev - , cardano-ledger-byron , cardano-node , cardano-prelude , containers diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 0c8b99c3e7b..81e777f968e 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -129,7 +129,6 @@ library , async , base16-bytestring , bytestring - , deepseq , cardano-api , cardano-data , cardano-git-rev @@ -176,7 +175,6 @@ library , scientific , strict-stm , cardano-ledger-shelley - , small-steps , stm , text , time diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index c2a1bb940d9..d0889a14bad 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -34,7 +34,6 @@ library , cardano-api , cardano-cli , cardano-node - , cardano-slotting , containers , directory , exceptions diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 536b36e4ecd..4c4edf21247 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -123,7 +123,6 @@ library , async-extras , bimap , blaze-html - , blaze-markup , bytestring , cardano-git-rev , cardano-node @@ -274,7 +273,6 @@ test-suite cardano-tracer-test , filepath , ouroboros-network , ouroboros-network-framework - , QuickCheck , stm , tasty , tasty-quickcheck