replace a bunch of custom Show instances for easier troubleshooting

Custom Show instances were obscuring important details in test failure
output again. The best policy seems to be: stick with default derived
Show instances as far as possible, but when necessary customize them
to conform to haskell syntax so pretty-show can do its thing (eg when
they contain Day values, cf https://github.com/haskell/time/issues/101).
This commit is contained in:
Simon Michael 2018-08-19 18:17:49 +01:00
parent 2778f6cf8f
commit 3e6159e632
4 changed files with 27 additions and 27 deletions

View File

@ -149,13 +149,6 @@ amountstyle = AmountStyle L False 0 (Just '.') Nothing
-------------------------------------------------------------------------------
-- Amount
instance Show Price where
show NoPrice = "NoPrice"
show (UnitPrice a) = "\"@ " ++ showAmountWithoutPrice a ++ "..\""
show (TotalPrice a) = "\"@@ " ++ showAmountWithoutPrice a ++ "..\""
deriving instance Show Amount
instance Num Amount where
abs a@Amount{aquantity=q} = a{aquantity=abs q}
signum a@Amount{aquantity=q} = a{aquantity=signum q}
@ -435,12 +428,6 @@ commodityValue j valuationdate c
-------------------------------------------------------------------------------
-- MixedAmount
instance Show MixedAmount where
show
| debugLevel < 3 = intercalate "\\n" . lines . showMixedAmountWithoutPrice
-- debugLevel < 6 = intercalate "\\n" . lines . showMixedAmount
| otherwise = showMixedAmountDebug
instance Num MixedAmount where
fromInteger i = Mixed [fromInteger i]
negate (Mixed as) = Mixed $ map negate as

View File

@ -76,7 +76,6 @@ import Hledger.Data.AccountName
import Hledger.Data.Dates (nulldate, spanContainsDate)
instance Show Posting where show = showPosting
nullposting, posting :: Posting
nullposting = Posting

View File

@ -62,11 +62,6 @@ import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
instance Show Transaction where show = showTransactionUnelided
instance Show TransactionModifier where
show t = "= " ++ T.unpack (tmquerytxt t) ++ "\n" ++ unlines (map show (tmpostings t))
sourceFilePath :: GenericSourcePos -> FilePath
sourceFilePath = \case
GenericSourcePos fp _ _ -> fp

View File

@ -26,6 +26,7 @@ import Control.DeepSeq (NFData)
import Data.Data
import Data.Decimal
import Data.Default
import Data.List (intercalate)
import Text.Blaze (ToMarkup(..))
import qualified Data.Map as M
import Data.Text (Text)
@ -128,7 +129,8 @@ instance ToMarkup Quantity
-- | An amount's price (none, per unit, or total) in another commodity.
-- Note the price should be a positive number, although this is not enforced.
data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord,Typeable,Data,Generic)
data Price = NoPrice | UnitPrice Amount | TotalPrice Amount
deriving (Eq,Ord,Typeable,Data,Generic,Show)
instance NFData Price
@ -145,7 +147,7 @@ instance NFData AmountStyle
instance Show AmountStyle where
show AmountStyle{..} =
printf "AmountStyle \"%s %s %s %s %s..\""
printf "AmountStylePP \"%s %s %s %s %s..\""
(show ascommodityside)
(show ascommodityspaced)
(show asprecision)
@ -178,11 +180,11 @@ data Amount = Amount {
aprice :: Price, -- ^ the (fixed) price for this amount, if any
astyle :: AmountStyle,
amultiplier :: Bool -- ^ amount is a multipier used in TransactionModifier postings
} deriving (Eq,Ord,Typeable,Data,Generic)
} deriving (Eq,Ord,Typeable,Data,Generic,Show)
instance NFData Amount
newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Typeable,Data,Generic)
newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Typeable,Data,Generic,Show)
instance NFData MixedAmount
@ -228,10 +230,27 @@ data Posting = Posting {
instance NFData Posting
-- The equality test for postings ignores the parent transaction's
-- identity, to avoid infinite loops.
-- identity, to avoid recuring ad infinitum.
-- XXX could check that it's Just or Nothing.
instance Eq Posting where
(==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _ _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _ _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2
-- | Posting's show instance elides the parent transaction so as not to recurse forever.
instance Show Posting where
show Posting{..} = "PostingPP {" ++ intercalate ", " [
("pdate=" ++ show (show pdate))
,("pdate2=" ++ show (show pdate2))
,("pstatus=" ++ show (show pstatus))
,("paccount=" ++ show paccount)
,("pamount=" ++ show pamount)
,("pcomment=" ++ show pcomment)
,("ptype=" ++ show ptype)
,("ptags=" ++ show ptags)
,("pbalanceassertion=" ++ show pbalanceassertion)
,("ptransaction=" ++ show (const "<txn>" <$> ptransaction))
,("porigin=" ++ show porigin)
] ++ "}"
-- TODO: needs renaming, or removal if no longer needed. See also TextPosition in Hledger.UI.Editor
-- | The position of parse errors (eg), like parsec's SourcePos but generic.
data GenericSourcePos = GenericSourcePos FilePath Int Int -- ^ file path, 1-based line number and 1-based column number.
@ -256,23 +275,23 @@ data Transaction = Transaction {
ttags :: [Tag], -- ^ tag names and values, extracted from the comment
tpostings :: [Posting], -- ^ this transaction's postings
tpreceding_comment_lines :: Text -- ^ any comment lines immediately preceding this transaction
} deriving (Eq,Typeable,Data,Generic)
} deriving (Eq,Typeable,Data,Generic,Show)
instance NFData Transaction
data TransactionModifier = TransactionModifier {
tmquerytxt :: Text,
tmpostings :: [Posting]
} deriving (Eq,Typeable,Data,Generic)
} deriving (Eq,Typeable,Data,Generic,Show)
instance NFData TransactionModifier
-- ^ A periodic transaction rule, describing a transaction that recurs.
nulltransactionmodifier = TransactionModifier{
tmquerytxt = ""
,tmpostings = []
}
-- | A periodic transaction rule, describing a transaction that recurs.
data PeriodicTransaction = PeriodicTransaction {
ptperiodexpr :: Text, -- ^ the period expression as written
ptinterval :: Interval, -- ^ the interval at which this transaction recurs