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:
parent
2778f6cf8f
commit
3e6159e632
@ -149,13 +149,6 @@ amountstyle = AmountStyle L False 0 (Just '.') Nothing
|
|||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Amount
|
-- 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
|
instance Num Amount where
|
||||||
abs a@Amount{aquantity=q} = a{aquantity=abs q}
|
abs a@Amount{aquantity=q} = a{aquantity=abs q}
|
||||||
signum a@Amount{aquantity=q} = a{aquantity=signum q}
|
signum a@Amount{aquantity=q} = a{aquantity=signum q}
|
||||||
@ -435,12 +428,6 @@ commodityValue j valuationdate c
|
|||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- MixedAmount
|
-- MixedAmount
|
||||||
|
|
||||||
instance Show MixedAmount where
|
|
||||||
show
|
|
||||||
| debugLevel < 3 = intercalate "\\n" . lines . showMixedAmountWithoutPrice
|
|
||||||
-- debugLevel < 6 = intercalate "\\n" . lines . showMixedAmount
|
|
||||||
| otherwise = showMixedAmountDebug
|
|
||||||
|
|
||||||
instance Num MixedAmount where
|
instance Num MixedAmount where
|
||||||
fromInteger i = Mixed [fromInteger i]
|
fromInteger i = Mixed [fromInteger i]
|
||||||
negate (Mixed as) = Mixed $ map negate as
|
negate (Mixed as) = Mixed $ map negate as
|
||||||
|
|||||||
@ -76,7 +76,6 @@ import Hledger.Data.AccountName
|
|||||||
import Hledger.Data.Dates (nulldate, spanContainsDate)
|
import Hledger.Data.Dates (nulldate, spanContainsDate)
|
||||||
|
|
||||||
|
|
||||||
instance Show Posting where show = showPosting
|
|
||||||
|
|
||||||
nullposting, posting :: Posting
|
nullposting, posting :: Posting
|
||||||
nullposting = Posting
|
nullposting = Posting
|
||||||
|
|||||||
@ -62,11 +62,6 @@ import Hledger.Data.Dates
|
|||||||
import Hledger.Data.Posting
|
import Hledger.Data.Posting
|
||||||
import Hledger.Data.Amount
|
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 :: GenericSourcePos -> FilePath
|
||||||
sourceFilePath = \case
|
sourceFilePath = \case
|
||||||
GenericSourcePos fp _ _ -> fp
|
GenericSourcePos fp _ _ -> fp
|
||||||
|
|||||||
@ -26,6 +26,7 @@ import Control.DeepSeq (NFData)
|
|||||||
import Data.Data
|
import Data.Data
|
||||||
import Data.Decimal
|
import Data.Decimal
|
||||||
import Data.Default
|
import Data.Default
|
||||||
|
import Data.List (intercalate)
|
||||||
import Text.Blaze (ToMarkup(..))
|
import Text.Blaze (ToMarkup(..))
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@ -128,7 +129,8 @@ instance ToMarkup Quantity
|
|||||||
|
|
||||||
-- | An amount's price (none, per unit, or total) in another commodity.
|
-- | 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.
|
-- 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
|
instance NFData Price
|
||||||
|
|
||||||
@ -145,7 +147,7 @@ instance NFData AmountStyle
|
|||||||
|
|
||||||
instance Show AmountStyle where
|
instance Show AmountStyle where
|
||||||
show AmountStyle{..} =
|
show AmountStyle{..} =
|
||||||
printf "AmountStyle \"%s %s %s %s %s..\""
|
printf "AmountStylePP \"%s %s %s %s %s..\""
|
||||||
(show ascommodityside)
|
(show ascommodityside)
|
||||||
(show ascommodityspaced)
|
(show ascommodityspaced)
|
||||||
(show asprecision)
|
(show asprecision)
|
||||||
@ -178,11 +180,11 @@ data Amount = Amount {
|
|||||||
aprice :: Price, -- ^ the (fixed) price for this amount, if any
|
aprice :: Price, -- ^ the (fixed) price for this amount, if any
|
||||||
astyle :: AmountStyle,
|
astyle :: AmountStyle,
|
||||||
amultiplier :: Bool -- ^ amount is a multipier used in TransactionModifier postings
|
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
|
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
|
instance NFData MixedAmount
|
||||||
|
|
||||||
@ -228,10 +230,27 @@ data Posting = Posting {
|
|||||||
instance NFData Posting
|
instance NFData Posting
|
||||||
|
|
||||||
-- The equality test for postings ignores the parent transaction's
|
-- 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
|
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 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
|
-- 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.
|
-- | 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.
|
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
|
ttags :: [Tag], -- ^ tag names and values, extracted from the comment
|
||||||
tpostings :: [Posting], -- ^ this transaction's postings
|
tpostings :: [Posting], -- ^ this transaction's postings
|
||||||
tpreceding_comment_lines :: Text -- ^ any comment lines immediately preceding this transaction
|
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
|
instance NFData Transaction
|
||||||
|
|
||||||
data TransactionModifier = TransactionModifier {
|
data TransactionModifier = TransactionModifier {
|
||||||
tmquerytxt :: Text,
|
tmquerytxt :: Text,
|
||||||
tmpostings :: [Posting]
|
tmpostings :: [Posting]
|
||||||
} deriving (Eq,Typeable,Data,Generic)
|
} deriving (Eq,Typeable,Data,Generic,Show)
|
||||||
|
|
||||||
instance NFData TransactionModifier
|
instance NFData TransactionModifier
|
||||||
|
|
||||||
-- ^ A periodic transaction rule, describing a transaction that recurs.
|
|
||||||
nulltransactionmodifier = TransactionModifier{
|
nulltransactionmodifier = TransactionModifier{
|
||||||
tmquerytxt = ""
|
tmquerytxt = ""
|
||||||
,tmpostings = []
|
,tmpostings = []
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | A periodic transaction rule, describing a transaction that recurs.
|
||||||
data PeriodicTransaction = PeriodicTransaction {
|
data PeriodicTransaction = PeriodicTransaction {
|
||||||
ptperiodexpr :: Text, -- ^ the period expression as written
|
ptperiodexpr :: Text, -- ^ the period expression as written
|
||||||
ptinterval :: Interval, -- ^ the interval at which this transaction recurs
|
ptinterval :: Interval, -- ^ the interval at which this transaction recurs
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user