diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 29023b5c2..1e79fe460 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -114,6 +114,12 @@ showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) = price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt Nothing -> "" +-- XXX refactor +-- | Get the unambiguous string representation of an amount, for debugging. +showAmountDebug :: Amount -> String +showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}" + (show c) (show q) (maybe "" showMixedAmountDebug pri) + -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice a = showAmount a{price=Nothing} @@ -171,11 +177,12 @@ mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZ -- its component amounts. NB a mixed amount can have an empty amounts -- list in which case it shows as \"\". showMixedAmount :: MixedAmount -> String -showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as - where - (Mixed as) = normaliseMixedAmount m - width = maximum $ map (length . show) as - showfixedwidth = printf (printf "%%%ds" width) . show +showMixedAmount m = vConcatRightAligned $ map show $ amounts $ normaliseMixedAmount m + +-- | Get an unambiguous string representation of a mixed amount for debugging. +showMixedAmountDebug :: MixedAmount -> String +showMixedAmountDebug m = printf "Mixed [%s]" as + where as = intercalate "\n " $ map showAmountDebug $ amounts $ normaliseMixedAmount m -- | Get the string representation of a mixed amount, but without -- any \@ prices. diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index d763d17b5..3ae2717c9 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -466,7 +466,7 @@ nosymbolamount = do "no-symbol amount" commoditysymbol :: GenParser Char st String -commoditysymbol = many1 (noneOf "-.0123456789;\n ") "commodity symbol" +commoditysymbol = many1 (noneOf "@-.0123456789;\n ") "commodity symbol" priceamount :: GenParser Char st (Maybe MixedAmount) priceamount = diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index d2683e844..42f456815 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -95,6 +95,13 @@ concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded | otherwise = maximum $ map length ls padded = map (xpad . ypad) lss +-- | Compose strings vertically and right-aligned. +vConcatRightAligned :: [String] -> String +vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss + where + showfixedwidth = printf (printf "%%%ds" width) + width = maximum $ map length ss + -- | Convert a multi-line string to a rectangular string top-padded to the specified height. padtop :: Int -> String -> String padtop h s = intercalate "\n" xpadded diff --git a/Tests.hs b/Tests.hs index 50b1beb9d..d83d50f7c 100644 --- a/Tests.hs +++ b/Tests.hs @@ -79,6 +79,9 @@ a `is` e = assertEqual "" e a parseis :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion parse `parseis` expected = either printParseError (`is` expected) parse +assertParse :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion +assertParse = parseis + ------------------------------------------------------------------------------ -- | Tests for any function or topic. Mostly ordered by test name. tests :: [Test] @@ -480,6 +483,9 @@ tests = [ ,"ledgerposting" ~: parseWithCtx emptyCtx ledgerposting rawposting1_str `parseis` rawposting1 + ,"normaliseMixedAmount" ~: do + normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt] + ,"parsedate" ~: do parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1 parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1 @@ -672,6 +678,9 @@ tests = [ ,"show hours" ~: show (hours 1) ~?= "1.0h" + ,"showMixedAmount" ~: do + showMixedAmount (Mixed []) ~?= "0" + ,"showTransaction" ~: do assertEqual "show a balanced transaction, eliding last amount" (unlines @@ -731,6 +740,26 @@ tests = [ [Posting False "expenses:food:groceries" missingamt "" RegularPosting Nothing ] "")) + assertEqual "show a transaction with a priced commodityless amount" + (unlines + ["2010/01/01 x" + ," a 1 @ $2" + ," b " + ,"" + ]) + (showTransaction + (txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" + [Posting False "a" (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting Nothing + ,Posting False "b" missingamt "" RegularPosting Nothing + ] "")) + + ,"someamount" ~: do + let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity + assertMixedAmountParse parseresult mixedamount = + (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) + assertMixedAmountParse (parsewith someamount "1 @ $2") + (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) + ,"unicode in balance layout" ~: do l <- ledgerFromStringWithOpts [] "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"