Try #2708:

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -45,6 +45,7 @@ module Test.Integration.Framework.DSL
     , (.>)
     , (.<)
     , verify
+    , verifyMsg
     , Headers(..)
     , Payload(..)
     , RequestException(..)
@@ -369,6 +370,8 @@ import Data.Time.Text
     ( iso8601ExtendedUtc, utcTimeToText )
 import Data.Word
     ( Word32, Word64 )
+import Fmt
+    ( indentF, (+|), (|+) )
 import Language.Haskell.TH.Quote
     ( QuasiQuoter )
 import Network.HTTP.Types.Method
@@ -402,6 +405,8 @@ import Test.Integration.Framework.Request
     , request
     , unsafeRequest
     )
+import Test.Utils.Pretty
+    ( pShowBuilder )
 import UnliftIO.Async
     ( async, race, wait )
 import UnliftIO.Concurrent
@@ -2285,11 +2290,21 @@ wantedErrorButSuccess = liftIO
     . ("expected an error but got a successful response: " <>)
     . show
 
--- | Apply 'a' to all actions in sequence
-verify :: (Show a, MonadIO m, MonadUnliftIO m) => a -> [a -> m ()] -> m ()
+-- | Applies the value 'a' to all assertions in the given sequence.
+--
+-- If any of the assertions fail, 'a' is shown as the counter-example text.
+verify :: (Show a, MonadUnliftIO m) => a -> [a -> m ()] -> m ()
 verify a = counterexample msg . mapM_ (a &)
   where
-    msg = "While verifying " ++ show a
+    msg = "While verifying value:\n"+|indentF 2 (pShowBuilder a)|+""
+
+-- | Applies the value 'a' to all assertions in the given sequence.
+--
+-- Like 'verify', but the counterexample shows a description of what conditions were being checked.
+verifyMsg :: (Show a, MonadUnliftIO m) => String -> a -> [a -> m ()] -> m ()
+verifyMsg desc a = counterexample msg . mapM_ (a &)
+  where
+    msg = "Verifying "+|desc|+" for value:\n"+|indentF 2 (pShowBuilder a)|+""
 
 -- | Can be used to add context to a @HUnitFailure@.
 --

lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs

@@ -37,6 +37,8 @@ import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Text.Class
+    ( ToText (..) )
 import System.Command
     ( Exit (..), Stderr (..), Stdout (..) )
 import System.Exit
@@ -75,6 +77,8 @@ import Test.Integration.Framework.DSL
     , updateWalletNameViaCLI
     , updateWalletPassphraseViaCLI
     , verify
+    , verifyMsg
+    , waitForTxImmutability
     , walletId
     , (.>)
     )
@@ -101,34 +105,33 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do
         c1 `shouldBe` ExitSuccess
         T.unpack e1 `shouldContain` cmdOk
         wDest <- expectValidJSON (Proxy @ApiWallet) o1
-        verify wDest
-            [ expectCliField
-                    (#balance . #available) (`shouldBe` Quantity 0)
-            , expectCliField
-                    (#balance . #total) (`shouldBe` Quantity 0)
+        verifyMsg "Wallet balance is as expected" wDest
+            [ expectCliField (#balance . #available) (`shouldBe` Quantity 0)
+            , expectCliField (#balance . #total) (`shouldBe` Quantity 0)
             ]
 
         --send transaction to the wallet
-        let amount = minUTxOValue
+        let amount = Quantity minUTxOValue
         addrs:_ <- listAddresses @n ctx wDest
         let addr = encodeAddress @n (getApiT $ fst $ addrs ^. #id)
         let args = T.unpack <$>
                 [ wSrc ^. walletId
-                , "--payment", T.pack (show amount) <> "@" <> addr
+                , "--payment", toText amount <> "@" <> addr
                 ]
 
         (cp, op, ep) <- postTransactionViaCLI ctx "cardano-wallet" args
         T.unpack ep `shouldContain` cmdOk
         _ <- expectValidJSON (Proxy @(ApiTransaction n)) op
         cp `shouldBe` ExitSuccess
 
-        eventually "Wallet balance is as expected" $ do
-            Stdout og <- getWalletViaCLI ctx $ T.unpack (wDest ^. walletId)
-            jg <- expectValidJSON (Proxy @ApiWallet) og
-            expectCliField (#balance . #available)
-                (`shouldBe` Quantity amount) jg
-            expectCliField (#balance . #total)
-                (`shouldBe` Quantity amount) jg
+        waitForTxImmutability ctx
+
+        Stdout og <- getWalletViaCLI ctx $ T.unpack (wDest ^. walletId)
+        jg <- expectValidJSON (Proxy @ApiWallet) og
+        verifyMsg "Wallet balance is as expected" jg
+            [ expectCliField (#balance . #available) (`shouldBe` amount)
+            , expectCliField (#balance . #total) (`shouldBe` amount)
+            ]
 
         -- delete wallet
         Exit cd <- deleteWalletViaCLI ctx $ T.unpack (wDest ^. walletId)
@@ -143,17 +146,14 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do
         wRestored <- expectValidJSON (Proxy @ApiWallet) o2
 
         -- make sure funds are there
-        eventually "Wallet balance is as expected on wallet from pubKey" $ do
-            Stdout o3 <- getWalletViaCLI ctx $ T.unpack (wRestored ^. walletId)
-            justRestored <- expectValidJSON (Proxy @ApiWallet) o3
-            verify justRestored
-                [ expectCliField
-                        (#balance . #available)
-                        (`shouldBe` Quantity amount)
-                , expectCliField
-                        (#balance . #total)
-                        (`shouldBe` Quantity amount)
-                ]
+        waitForTxImmutability ctx
+
+        Stdout o3 <- getWalletViaCLI ctx $ T.unpack (wRestored ^. walletId)
+        justRestored <- expectValidJSON (Proxy @ApiWallet) o3
+        verifyMsg "Wallet balance is as expected" justRestored
+            [ expectCliField (#balance . #available) (`shouldBe` amount)
+            , expectCliField (#balance . #total) (`shouldBe` amount)
+            ]
 
     describe "HW_WALLETS_03 - Cannot do operations requiring private key" $ do
         it "Cannot send tx" $ \ctx -> runResourceT $ do

lib/core/test/unit/Cardano/Wallet/Primitive/Migration/PlanningSpec.hs

@@ -24,7 +24,6 @@ import Cardano.Wallet.Primitive.Migration.Selection
 import Cardano.Wallet.Primitive.Migration.SelectionSpec
     ( MockInputId
     , MockTxConstraints (..)
-    , Pretty (..)
     , genMockInput
     , genRewardWithdrawal
     , genTokenBundleMixed
@@ -73,6 +72,8 @@ import Test.QuickCheck
     , withMaxSuccess
     , (===)
     )
+import Test.Utils.Pretty
+    ( Pretty (..) )
 
 import qualified Cardano.Wallet.Primitive.Migration.Selection as Selection
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin

lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs

@@ -73,7 +73,7 @@ import Data.Semigroup
 import Data.Word
     ( Word8 )
 import Fmt
-    ( Builder, build, indentF, pretty )
+    ( indentF, pretty, (+|), (|+) )
 import Numeric.Natural
     ( Natural )
 import Test.Hspec
@@ -104,8 +104,8 @@ import Test.QuickCheck
     , withMaxSuccess
     , (.&&.)
     )
-import Text.Pretty.Simple
-    ( pShow )
+import Test.Utils.Pretty
+    ( pShowBuilder )
 
 import qualified Cardano.Wallet.Primitive.Migration.Selection as Selection
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
@@ -117,7 +117,6 @@ import qualified Data.Foldable as F
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
 import qualified Data.Text.Encoding as T
-import qualified Data.Text.Lazy as TL
 
 spec :: Spec
 spec = describe "Cardano.Wallet.Primitive.Migration.SelectionSpec" $
@@ -1063,15 +1062,7 @@ instance Arbitrary a => Arbitrary (NonEmpty a) where
 -- On failure, uses pretty-printing to show the contents of the variable.
 --
 report :: (Show a, Testable prop) => a -> String -> prop -> Property
-report a name = counterexample
-    $ pretty $ mconcat
-    [ buildPretty name
-    , build @String ":\n"
-    , indentF 4 (buildPretty a)
-    ]
-  where
-    buildPretty :: Show b => b -> Builder
-    buildPretty = build . TL.unpack . pShow
+report a name = counterexample (""+|name|+":\n"+|indentF 4 (pShowBuilder a)|+"")
 
 -- | Adds a named condition to a property.
 --
@@ -1081,10 +1072,7 @@ verify :: Bool -> String -> Property -> Property
 verify condition conditionTitle =
     (.&&.) (counterexample counterexampleText $ property condition)
   where
-    counterexampleText = mconcat
-        [ "Condition violated: "
-        , TL.unpack (pShow conditionTitle)
-        ]
+    counterexampleText = "Condition violated: " <> conditionTitle
 
 -- | Tests a collection of properties defined with 'verify'.
 --
@@ -1107,17 +1095,3 @@ matchRight f result = case result of
 
 scaleCoin :: Coin -> Int -> Coin
 scaleCoin (Coin c) s = Coin $ c * fromIntegral s
-
---------------------------------------------------------------------------------
--- Pretty-printing
---------------------------------------------------------------------------------
-
-newtype Pretty a = Pretty { unPretty :: a }
-    deriving Eq
-
-instance Arbitrary a => Arbitrary (Pretty a) where
-    arbitrary = Pretty <$> arbitrary
-    shrink (Pretty a) = Pretty <$> shrink a
-
-instance Show a => Show (Pretty a) where
-    show (Pretty a) = TL.unpack $ pShow a

lib/test-utils/cardano-wallet-test-utils.cabal

@@ -34,6 +34,7 @@ library
     , contra-tracer
     , filepath
     , file-embed
+    , formatting
     , hspec
     , hspec-core
     , hspec-expectations
@@ -42,10 +43,12 @@ library
     , HUnit
     , iohk-monitoring
     , lattices
+    , pretty-simple
     , QuickCheck
     , quickcheck-classes
     , say
     , template-haskell
+    , text
     , text-class
     , time
     , unliftio
@@ -62,6 +65,7 @@ library
       Test.Utils.Laws
       Test.Utils.Laws.PartialOrd
       Test.Utils.Paths
+      Test.Utils.Pretty
       Test.Utils.Roundtrip
       Test.Utils.Resource
       Test.Utils.StaticServer

lib/test-utils/src/Test/Utils/Pretty.hs

@@ -0,0 +1,41 @@
+-- | A convenience wrapper type for pretty-showing test values.
+
+module Test.Utils.Pretty
+    ( Pretty (..)
+    , pShowBuilder
+    ) where
+
+import Prelude
+
+import Data.Text.Class
+    ( ToText (..) )
+import Data.Text.Lazy.Builder
+    ( Builder, fromLazyText )
+import Formatting.Buildable
+    ( Buildable (..) )
+import Test.QuickCheck
+    ( Arbitrary (..) )
+import Text.Pretty.Simple
+    ( pShow )
+
+import qualified Data.Text.Lazy as TL
+
+newtype Pretty a = Pretty { unPretty :: a }
+    deriving Eq
+
+instance Arbitrary a => Arbitrary (Pretty a) where
+    arbitrary = Pretty <$> arbitrary
+    shrink (Pretty a) = Pretty <$> shrink a
+
+instance Show a => Show (Pretty a) where
+    show = TL.unpack . pShow . unPretty
+
+instance Show a => Buildable (Pretty a) where
+    build = build . pShow . unPretty
+
+instance Show a => ToText (Pretty a)
+
+-- | Pretty-show a value as a lazy text 'Builder'. This is handy for using with
+-- the "Fmt" module.
+pShowBuilder :: Show a => a -> Builder
+pShowBuilder = fromLazyText . pShow

lib/text-class/src/Data/Text/Class.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -54,8 +55,10 @@ import Data.Word
     ( Word32, Word64 )
 import Data.Word.Odd
     ( Word31 )
-import Fmt
-    ( Buildable )
+import Formatting
+    ( builder, sformat )
+import Formatting.Buildable
+    ( Buildable (..) )
 import GHC.Generics
     ( Generic )
 import Numeric.Natural
@@ -80,6 +83,9 @@ class ToText a where
     -- | Encode the specified value as text.
     toText :: a -> Text
 
+    default toText :: Buildable a => a -> Text
+    toText = sformat builder . build
+
 -- | Defines a textual decoding for a type.
 class FromText a where
     -- | Decode the specified text as a value.

lib/text-class/text-class.cabal

@@ -31,7 +31,7 @@ library
       base
     , casing
     , extra
-    , fmt
+    , formatting
     , text
     , time
     , hspec