From d94ca1eb2257a708531c5fad84dfb4c4c3c24f5f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 19 Oct 2023 02:30:54 +0000 Subject: [PATCH 1/6] Selectively ignore hlint suggestion to use numeric underscores. --- lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs b/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs index 4738e4945b4..1f2df86d680 100644 --- a/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs +++ b/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs @@ -2184,6 +2184,7 @@ block0 = W.Block , delegations = [] } +{- HLINT ignore costModelsForTesting "Use underscore" -} costModelsForTesting :: Alonzo.CostModels costModelsForTesting = either (error . show) id $ do v1 <- Alonzo.mkCostModel PlutusV1 From 077e45ae9fec1c9ae4506f6808e4ef7e001da9a9 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 19 Oct 2023 04:29:33 +0000 Subject: [PATCH 2/6] Remove redundant usages of `TemplateHaskell`. --- lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster.hs index 16884d05d19..777fc94e642 100644 --- a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster.hs +++ b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster.hs @@ -12,7 +12,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} From 73012c1851c0080e6c6e8155e899305fa6a8abf4 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 19 Oct 2023 03:53:59 +0000 Subject: [PATCH 3/6] Remove redundant usages of `<$>` and `fmap`. --- .../Cardano/CoinSelection/CollateralSpec.hs | 2 +- .../Cardano/CoinSelection/UTxOIndexSpec.hs | 27 +++++++++++++------ .../Wallet/Primitive/Types/TokenMap.hs | 2 +- .../Wallet/Primitive/Types/TokenMapSpec.hs | 2 +- .../src/Cardano/Wallet/Spec/Effect/Random.hs | 13 +++++---- .../Wallet/Api/Http/Server/Handlers/TxCBOR.hs | 8 +++--- lib/wallet/src/Data/Time/Text.hs | 11 +++++--- .../test/unit/Cardano/Pool/DB/Arbitrary.hs | 2 +- .../test/unit/Cardano/Wallet/ApiSpec.hs | 2 +- .../Wallet/Primitive/Types/Tx/TxSeqSpec.hs | 10 +++---- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 2 +- 11 files changed, 50 insertions(+), 31 deletions(-) diff --git a/lib/coin-selection/test/spec/Cardano/CoinSelection/CollateralSpec.hs b/lib/coin-selection/test/spec/Cardano/CoinSelection/CollateralSpec.hs index 20b4fa7b0cb..2cf8e5327a1 100644 --- a/lib/coin-selection/test/spec/Cardano/CoinSelection/CollateralSpec.hs +++ b/lib/coin-selection/test/spec/Cardano/CoinSelection/CollateralSpec.hs @@ -881,7 +881,7 @@ prop_subsequencesOfSize = == Set.size subsets , Set.unions (F.toList subsets) == xs - , all (== k) (length <$> subsequences) + , all ((== k) . length) subsequences ] where n = Set.size xs diff --git a/lib/coin-selection/test/spec/Cardano/CoinSelection/UTxOIndexSpec.hs b/lib/coin-selection/test/spec/Cardano/CoinSelection/UTxOIndexSpec.hs index dfab79c12f6..59709e17571 100644 --- a/lib/coin-selection/test/spec/Cardano/CoinSelection/UTxOIndexSpec.hs +++ b/lib/coin-selection/test/spec/Cardano/CoinSelection/UTxOIndexSpec.hs @@ -533,17 +533,28 @@ prop_selectRandom_all index f = monadicIO $ , F.foldl' (flip (uncurry UTxOIndex.insert)) indexReduced selected === index , property - $ all (`UTxOIndex.member` index) - $ fst <$> selected + $ all + ((`UTxOIndex.member` index) . fst) + selected , property - $ all (not . (`UTxOIndex.member` indexReduced)) - $ fst <$> selected + $ all + (not . (`UTxOIndex.member` indexReduced) . fst) + selected , property - $ all (selectionFilterMatchesBundleCategory f) - $ categorizeTokenBundle . snd <$> selected + $ all + ( selectionFilterMatchesBundleCategory f + . categorizeTokenBundle + . snd + ) + selected , property - $ all (not . selectionFilterMatchesBundleCategory f) - $ categorizeTokenBundle . snd <$> UTxOIndex.toList indexReduced + $ all + ( not + . selectionFilterMatchesBundleCategory f + . categorizeTokenBundle + . snd + ) + (UTxOIndex.toList indexReduced) ] -- | Verify that priority order is respected when selecting with more than diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenMap.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenMap.hs index 84c3533c085..7b114162787 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenMap.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenMap.hs @@ -501,7 +501,7 @@ toFlatList b = toNestedList :: TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))] toNestedList (TokenMap m) = - mapMaybe (traverse NE.nonEmpty . fmap MonoidMap.toList) $ MonoidMap.toList m + mapMaybe (traverse (NE.nonEmpty . MonoidMap.toList)) $ MonoidMap.toList m -- | Converts a token map to a nested map. -- diff --git a/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/TokenMapSpec.hs b/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/TokenMapSpec.hs index 98add954373..fdf766c3a1c 100644 --- a/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/TokenMapSpec.hs +++ b/lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/TokenMapSpec.hs @@ -420,7 +420,7 @@ prop_adjustQuantity_hasQuantity b asset = prop_maximumQuantity_all :: TokenMap -> Property prop_maximumQuantity_all b = - property $ all (<= maxQ) (snd <$> TokenMap.toFlatList b) + property $ all ((<= maxQ) . snd) (TokenMap.toFlatList b) where maxQ = TokenMap.maximumQuantity b diff --git a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Random.hs b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Random.hs index e9fb71690b8..a8d01bef703 100644 --- a/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Random.hs +++ b/lib/wallet-e2e/src/Cardano/Wallet/Spec/Effect/Random.hs @@ -66,11 +66,14 @@ runRandom gen = reinterpret (evalState gen) \_ -> \case RandomMnemonic -> do randomByteString <- uniformByteStringM 32 stGen mnemonic <- - Mnemonic.unsafeFromList - . Cardano.mnemonicToText - . Cardano.entropyToMnemonic - <$> toEntropy @256 randomByteString - & either (fail . show) pure + either + (fail . show) + (pure + . Mnemonic.unsafeFromList + . Cardano.mnemonicToText + . Cardano.entropyToMnemonic + ) + (toEntropy @256 randomByteString) trace $ "Generated a random mnemonic: " <> Mnemonic.toText mnemonic pure mnemonic RandomWalletName (Tagged prefix) -> do diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Handlers/TxCBOR.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Handlers/TxCBOR.hs index a8d8a05a38e..950489644f2 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Handlers/TxCBOR.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Handlers/TxCBOR.hs @@ -59,8 +59,6 @@ import Cardano.Wallet.Transaction ( TokenMapWithScripts, ValidityIntervalExplicit ) import Control.Category ( (<<<) ) -import Data.Function - ( (&) ) import GHC.Generics ( Generic ) import Servant.Server @@ -111,5 +109,7 @@ txCBORParser = parser *.** deserializeTx -- | Parse CBOR to some values and throw a server deserialize error if failing. parseTxCBOR :: TxCBOR -> Handler ParsedTxCBOR parseTxCBOR cbor = - extractEraValue <$> sequenceEraValue (applyEraFun txCBORParser cbor) - & either (liftE . ErrParseCBOR) pure + either + (liftE . ErrParseCBOR) + (pure . extractEraValue) + (sequenceEraValue (applyEraFun txCBORParser cbor)) diff --git a/lib/wallet/src/Data/Time/Text.hs b/lib/wallet/src/Data/Time/Text.hs index ffac9d95ab6..9cd90e83fcf 100644 --- a/lib/wallet/src/Data/Time/Text.hs +++ b/lib/wallet/src/Data/Time/Text.hs @@ -51,9 +51,14 @@ utcTimeToText f = T.pack . formatTime defaultTimeLocale (timeFormatPattern f) -- 'Nothing' if none of the formats matched. -- utcTimeFromText :: [TimeFormat] -> Text -> Maybe UTCTime -utcTimeFromText fs t = foldr (<|>) Nothing $ - flip (parseTimeM False defaultTimeLocale) (T.unpack t) . timeFormatPattern - <$> fs +utcTimeFromText fs t = + foldr + ( (<|>) + . flip (parseTimeM False defaultTimeLocale) (T.unpack t) + . timeFormatPattern + ) + Nothing + fs -- | Represents a particular way of representing a moment in time in text. data TimeFormat = TimeFormat diff --git a/lib/wallet/test/unit/Cardano/Pool/DB/Arbitrary.hs b/lib/wallet/test/unit/Cardano/Pool/DB/Arbitrary.hs index b7d2d53d91c..981ae11a1b8 100644 --- a/lib/wallet/test/unit/Cardano/Pool/DB/Arbitrary.hs +++ b/lib/wallet/test/unit/Cardano/Pool/DB/Arbitrary.hs @@ -249,7 +249,7 @@ isValidSinglePoolCertificateSequence firstCertificateIsNotRetirement where allCertificatesReferToSamePool = - all (== sharedPoolId) (getPoolCertificatePoolId <$> certificates) + all ((== sharedPoolId) . getPoolCertificatePoolId) certificates firstCertificateIsNotRetirement = case certificates of [] -> True Registration _ : _ -> True diff --git a/lib/wallet/test/unit/Cardano/Wallet/ApiSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/ApiSpec.hs index f92946fe3a1..65e65bb5bb1 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/ApiSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/ApiSpec.hs @@ -277,7 +277,7 @@ instance :: Applicative m => (l0 -> m l1) -> [(l0, r)] -> m [(l1, r)] traverseLeft fn xs = - fmap swap <$> traverse (traverse fn) (swap <$> xs) + fmap swap <$> traverse (traverse fn . swap) xs instance ( KnownSymbol h diff --git a/lib/wallet/test/unit/Cardano/Wallet/Primitive/Types/Tx/TxSeqSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Primitive/Types/Tx/TxSeqSpec.hs index ee54d58768c..f78e80bb168 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Primitive/Types/Tx/TxSeqSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Primitive/Types/Tx/TxSeqSpec.hs @@ -274,8 +274,8 @@ prop_dropGroupBoundary_isValid (getTxSeq -> txSeq) = prop_dropGroupBoundary_toTxs :: ShrinkableTxSeq -> Property prop_dropGroupBoundary_toTxs (getTxSeq -> txSeq) = all - (== TxSeq.toTxList txSeq) - (TxSeq.toTxList <$> TxSeq.dropGroupBoundary txSeq) + ((== TxSeq.toTxList txSeq) . TxSeq.toTxList) + (TxSeq.dropGroupBoundary txSeq) === True prop_dropGroupBoundary_txGroupCount_length @@ -291,8 +291,8 @@ prop_dropGroupBoundary_txGroupCount_pred (getTxSeq -> txSeq) | txGroupCount == 0 = TxSeq.dropGroupBoundary txSeq === [] | otherwise = - all (== pred txGroupCount) - (TxSeq.txGroupCount <$> TxSeq.dropGroupBoundary txSeq) + all ((== pred txGroupCount) . TxSeq.txGroupCount) + (TxSeq.dropGroupBoundary txSeq) === True where txGroupCount = TxSeq.txGroupCount txSeq @@ -396,7 +396,7 @@ prop_shrinkTxSeq_genShrinkSequence_isValid :: Property prop_shrinkTxSeq_genShrinkSequence_isValid = forAll (genShrinkSequence shrinkTxSeq =<< genTxSeq genUTxO genAddress) $ \txSeqShrinks -> - all TxSeq.isValid (getTxSeq <$> txSeqShrinks) + all (TxSeq.isValid . getTxSeq) txSeqShrinks prop_shrinkTxSeq_genShrinkSequence_length :: Property prop_shrinkTxSeq_genShrinkSequence_length = diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index dfbbcd2d37d..22bdcd01ab9 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -577,7 +577,7 @@ withBodyContent era modTxBody cont = checkSubsetOf :: (Eq a, Show a) => [a] -> [a] -> Property checkSubsetOf as bs = property $ counterexample counterexampleText - $ all (`Set.member` ys) (ShowOrd <$> as) + $ all ((`Set.member` ys) . ShowOrd) as where xs = Set.fromList (ShowOrd <$> as) ys = Set.fromList (ShowOrd <$> bs) From 06b25fc29e07af8d3eb8f71f2d1a54e08dca9b7f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 19 Oct 2023 04:11:02 +0000 Subject: [PATCH 4/6] Remove redundant usages of `concatMap`. --- lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs index 3fdc2c7c80f..bb5ea04d7d2 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -1036,7 +1036,7 @@ validateGenerators = describe "Validate generators & shrinkers" $ do sanityCheckShrink = \case [] -> pure () - [x] -> sanityCheckShrink (concatMap shrinker [x]) + [x] -> sanityCheckShrink (shrinker x) xs -> sanityCheckShrink (concatMap shrinker [head xs, last xs]) dbLayerUnused :: DBLayer m s From d8546e8a2ff44b7bf1e1110146c88b8cff8c8358 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 19 Oct 2023 04:31:06 +0000 Subject: [PATCH 5/6] Simplify expression by using `mapM_` instead of `sequence_`. --- lib/wallet/src/Cardano/DB/Sqlite.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/wallet/src/Cardano/DB/Sqlite.hs b/lib/wallet/src/Cardano/DB/Sqlite.hs index f252d31ee77..e4d2b12c32e 100644 --- a/lib/wallet/src/Cardano/DB/Sqlite.hs +++ b/lib/wallet/src/Cardano/DB/Sqlite.hs @@ -546,7 +546,7 @@ noManualMigration :: ManualMigration noManualMigration = ManualMigration $ const $ pure () foldMigrations :: [Sqlite.Connection -> IO ()] -> ManualMigration -foldMigrations ms = ManualMigration $ \conn -> sequence_ $ ms <&> ($ conn) +foldMigrations ms = ManualMigration $ \conn -> mapM_ ($ conn) ms data DBField where DBField From 20e79d48ef31dc68fe0dbac2d455e46c286ccf20 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Thu, 19 Oct 2023 04:33:55 +0000 Subject: [PATCH 6/6] Selectively apply eta reduction to certain integration test functions. --- .../src/Test/Integration/Scenario/API/Byron/Transactions.hs | 3 +-- .../src/Test/Integration/Scenario/API/Shared/Transactions.hs | 3 +-- .../Test/Integration/Scenario/API/Shelley/TransactionsNew.hs | 3 +-- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/lib/wallet/integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/wallet/integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index 7ebccf99227..165bc91f26d 100644 --- a/lib/wallet/integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/wallet/integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -795,14 +795,13 @@ spec = describe "BYRON_TRANSACTIONS" $ do rl3 <- request @([ApiTransaction n]) ctx linkList3 Default Empty verify rl3 [expectListSize 2] where - listTransactionsFilteredByAddress wallet addrM = + listTransactionsFilteredByAddress wallet = Link.listTransactions' @'Byron wallet Nothing Nothing Nothing Nothing Nothing - addrM oneAda :: Integer oneAda = 1_000_000 diff --git a/lib/wallet/integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs b/lib/wallet/integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs index ef9b4b5915a..14000c81a7c 100644 --- a/lib/wallet/integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs +++ b/lib/wallet/integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs @@ -2707,14 +2707,13 @@ spec = describe "SHARED_TRANSACTIONS" $ do rl1c <- request @([ApiTransaction n]) ctx linkList1a Default Empty verify rl1c [expectListSize 2] where - listTransactionsFilteredByAddress wallet addrM = + listTransactionsFilteredByAddress wallet = Link.listTransactions' @'Shared wallet Nothing Nothing Nothing Nothing Nothing - addrM oneAda :: Integer oneAda = 1_000_000 diff --git a/lib/wallet/integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs b/lib/wallet/integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs index 2a876bbab55..10a50347934 100644 --- a/lib/wallet/integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs +++ b/lib/wallet/integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs @@ -4486,14 +4486,13 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do rl1c <- request @([ApiTransaction n]) ctx query1 Default Empty verify rl1c [expectListSize 2] where - listTransactionsFilteredByAddress wallet addrM = + listTransactionsFilteredByAddress wallet = Link.listTransactions' @'Shelley wallet Nothing Nothing Nothing Nothing Nothing - addrM -- | Just one million Ada, in Lovelace. oneMillionAda :: Integer