From ab7dc3294e1052668490a6f8edff8c170ab3da4b Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Wed, 15 Aug 2018 11:11:38 +0100
Subject: [PATCH] lib: more informative failure output for amount tests (#812)

---
 hledger-lib/Hledger/Read/Common.hs        | 10 ++++------
 hledger-lib/Hledger/Read/JournalReader.hs |  3 ++-
 hledger-lib/Hledger/Utils/Test.hs         | 18 +++++++++++++++---
 3 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index 0bf9092e6..2f2366361 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/hledger-lib/Hledger/Read/Common.hs
@@ -593,12 +593,10 @@ amountwithoutpricep = do
 test_amountp = TestCase $ do
     assertParseEqual' (parseWithState mempty amountp "$47.18") (usd 47.18)
     assertParseEqual' (parseWithState mempty amountp "$1.") (usd 1 `withPrecision` 0)
-  -- ,"amount with unit price" ~: do
-    assertParseEqual'
-     (parseWithState mempty amountp "$10 @ €0.5")
-     (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))
-  -- ,"amount with total price" ~: do
-    assertParseEqual'
+    assertParseEqual'' "amount with unit price"
+      (parseWithState mempty amountp "$10 @ €0.5")
+      (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))
+    assertParseEqual'' "amount with total price"
      (parseWithState mempty amountp "$10 @@ €5")
      (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
 
diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index 7a5897c8f..180da4dd4 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -675,7 +675,8 @@ test_postingp = TestCase $ do
                          same "date" pdate
                          same "status" pstatus
                          same "account" paccount
-                         same "amount" pamount
+                         -- same "amount" pamount
+                         assertEqual "Posting amount differs!" (showMixedAmountDebug $ pamount ep) (showMixedAmountDebug $ pamount ap)
                          same "comment" pcomment
                          same "type" ptype
                          same "tags" ptags
diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs
index 85c8a9b1e..1afdefe7f 100644
--- a/hledger-lib/Hledger/Utils/Test.hs
+++ b/hledger-lib/Hledger/Utils/Test.hs
@@ -3,6 +3,7 @@ module Hledger.Utils.Test where
 import Data.Functor.Identity
 import Test.HUnit
 import Text.Megaparsec
+import Hledger.Utils.Debug (pshow)
 
 -- | Get a Test's label, or the empty string.
 testName :: Test -> String
@@ -38,10 +39,21 @@ assertParseFailure parse = either (const $ return ()) (const $ assertFailure "pa
 assertParseEqual :: (Show a, Eq a, Show t, Show e) => (Either (ParseError t e) a) -> a -> Assertion
 assertParseEqual parse expected = either (assertFailure.show) (`is` expected) parse
 
--- | Assert that the parse result returned from an identity monad is some expected value, 
--- printing the parse error on failure.
+-- | Assert that the parse result returned from an identity monad is some expected value,
+-- on failure printing the parse error or differing values.
 assertParseEqual' :: (Show a, Eq a, Show t, Show e) => Identity (Either (ParseError t e) a) -> a -> Assertion
-assertParseEqual' parse expected = either (assertFailure.show) (`is` expected) (runIdentity parse)
+assertParseEqual' parse expected = 
+  either 
+    (assertFailure . ("parse error: "++) . pshow) 
+    (\actual -> assertEqual (unlines ["expected: " ++ show expected, " but got: " ++ show actual]) expected actual) 
+    $ runIdentity parse
+
+assertParseEqual'' :: (Show a, Eq a, Show t, Show e) => String -> Identity (Either (ParseError t e) a) -> a -> Assertion
+assertParseEqual'' label parse expected = 
+  either 
+    (assertFailure . ("parse error: "++) . pshow) 
+    (\actual -> assertEqual (unlines [label, "expected: " ++ show expected, " but got: " ++ show actual]) expected actual) 
+    $ runIdentity parse
 
 printParseError :: (Show a) => a -> IO ()
 printParseError e = do putStr "parse error at "; print e