hledger-lib 0.19 → 0.19.1

raw patch · 9 files changed

+127/−20 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Hledger/Data/Account.hs +2/−2
• Hledger/Data/Amount.hs +64/−11
• Hledger/Data/Commodity.hs +2/−1
• Hledger/Data/Dates.hs +1/−0
• Hledger/Data/Transaction.hs +16/−1
• Hledger/Data/Types.hs +1/−0
• Hledger/Read/JournalReader.hs +33/−3
• Hledger/Utils.hs +7/−1
• hledger-lib.cabal +1/−1

@@ -26,7 +26,7 @@ instance Show Account where     show Account{..} = printf "Account %s (boring:%s, ebalance:%s, ibalance:%s)"                        aname  -                       (if aboring then "y" else "n")+                       (if aboring then "y" else "n" :: String)                        (showMixedAmount aebalance)                        (showMixedAmount aibalance) @@ -159,7 +159,7 @@                      (aname a)                      (showMixedAmount $ aebalance a)                      (showMixedAmount $ aibalance a)-                     (if aboring a then "b" else " ")+                     (if aboring a then "b" else " " :: String)   tests_Hledger_Data_Account = TestList [

@@ -51,6 +51,7 @@   -- ** arithmetic   costOfAmount,   divideAmount,+  sumAmounts,   -- ** rendering   showAmount,   showAmountDebug,@@ -62,6 +63,7 @@   missingmixedamt,   amounts,   normaliseMixedAmountPreservingFirstPrice,+  normaliseMixedAmountPreservingPrices,   canonicaliseMixedAmountCommodity,   mixedAmountWithCommodity,   setMixedAmountPrecision,@@ -77,6 +79,7 @@   showMixedAmountWithoutPrice,   showMixedAmountWithPrecision,   -- * misc.+  ltraceamount,   tests_Hledger_Data_Amount ) where @@ -125,6 +128,24 @@ amountWithCommodity :: Commodity -> Amount -> Amount amountWithCommodity c (Amount _ q _) = Amount c q Nothing +-- | A more complete amount adding operation.+sumAmounts :: [Amount] -> MixedAmount+sumAmounts = normaliseMixedAmountPreservingPrices . Mixed++tests_sumAmounts = [+  "sumAmounts" ~: do+    -- when adding, we don't convert to the price commodity - just+    -- combine what amounts we can.+    -- amounts with same unit price+    (sumAmounts [(Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 1]))])+     `is` (Mixed [Amount dollar 2 (Just $ UnitPrice $ Mixed [euros 1])])+    -- amounts with different unit prices+    -- amounts with total prices+    (sumAmounts  [(Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]))])+     `is` (Mixed [(Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]))])+    -- amounts with no, unit, and/or total prices+ ]+ -- | Convert an amount to the commodity of its assigned price, if any.  Notes: -- -- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error)@@ -146,16 +167,18 @@ isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{quantity=q} = q < 0 +digits = "123456789" :: String+ -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool isZeroAmount a --  a==missingamt = False-               | otherwise     = (null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity) a+               | otherwise     = (null . filter (`elem` digits) . showAmountWithoutPriceOrCommodity) a  -- | Is this amount "really" zero, regardless of the display precision ? -- Since we are using floating point, for now just test to some high precision. isReallyZeroAmount :: Amount -> Bool isReallyZeroAmount a --  a==missingamt = False-                     | otherwise     = (null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity) a+                     | otherwise     = (null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") . quantity) a     where zeroprecision = 8  -- | Get the string representation of an amount, based on its commodity's@@ -200,10 +223,10 @@       R -> printf "%s%s%s%s" quantity' space sym' price     where       quantity = showamountquantity a-      displayingzero = null $ filter (`elem` "123456789") $ quantity+      displayingzero = null $ filter (`elem` digits) $ quantity       (quantity',sym') | displayingzero = ("0","")                        | otherwise      = (quantity,quoteCommoditySymbolIfNeeded sym)-      space = if (not (null sym') && spaced) then " " else ""+      space = if (not (null sym') && spaced) then " " else "" :: String       price = maybe "" showPrice pri  -- | Get the string representation of the number part of of an amount,@@ -282,9 +305,9 @@ missingmixedamt :: MixedAmount missingmixedamt = Mixed [missingamt] --- | Simplify a mixed amount's component amounts: combine amounts with the--- same commodity and price. Also remove any zero or missing amounts and--- replace an empty amount list with a single zero amount.+-- | Simplify a mixed amount's component amounts: we can combine amounts+-- with the same commodity and unit price. Also remove any zero or missing+-- amounts and replace an empty amount list with a single zero amount. normaliseMixedAmountPreservingPrices :: MixedAmount -> MixedAmount normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as''     where@@ -292,13 +315,29 @@       (_,nonzeros) = partition isReallyZeroAmount $ filter (/= missingamt) as'       as' = map sumAmountsUsingFirstPrice $ group $ sort as       sort = sortBy (\a1 a2 -> compare (sym a1,price a1) (sym a2,price a2))-      group = groupBy (\a1 a2 -> sym a1 == sym a2 && price a1 == price a2)       sym = symbol . commodity+      group = groupBy (\a1 a2 -> sym a1 == sym a2 && sameunitprice a1 a2)+        where+          sameunitprice a1 a2 =+            case (price a1, price a2) of+              (Nothing, Nothing) -> True+              (Just (UnitPrice p1), Just (UnitPrice p2)) -> p1 == p2+              _ -> False  tests_normaliseMixedAmountPreservingPrices = [   "normaliseMixedAmountPreservingPrices" ~: do-   -- assertEqual "" (Mixed [dollars 2]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, dollars 2])-   assertEqual "" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, missingamt])+   assertEqual "discard missing amount" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, missingamt])+   assertEqual "combine unpriced same-commodity amounts" (Mixed [dollars 2]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, dollars 2])+   assertEqual "don't combine total-priced amounts"+     (Mixed+      [Amount dollar 1    (Just $ TotalPrice $ Mixed [euros 1])+      ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])+      ])+     (normaliseMixedAmountPreservingPrices $ Mixed+      [Amount dollar 1    (Just $ TotalPrice $ Mixed [euros 1])+      ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])+      ])+  ]  -- | Simplify a mixed amount's component amounts: combine amounts with@@ -377,6 +416,10 @@ showMixedAmount :: MixedAmount -> String showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m +-- | Compact labelled trace of a mixed amount.+ltraceamount :: String -> MixedAmount -> MixedAmount+ltraceamount s = tracewith (((s ++ ": ") ++).showMixedAmount)+ -- | Set the display precision in the amount's commodities. setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as@@ -414,6 +457,7 @@  tests_Hledger_Data_Amount = TestList $      tests_normaliseMixedAmountPreservingPrices+  ++ tests_sumAmounts   ++ [    -- Amount@@ -434,7 +478,7 @@     let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}     negate b `is` b{quantity=(-1)} -  ,"adding amounts" ~: do+  ,"adding amounts without prices" ~: do     let a1 = dollars 1.23     let a2 = dollars (-1.23)     let a3 = dollars (-1.23)@@ -471,6 +515,15 @@               Amount dollar0 (-1) Nothing,               Amount dollar (-0.25) Nothing])       `is` Mixed [Amount unknown 0 Nothing]++  ,"adding mixed amounts with total prices" ~: do+    (sum $ map (Mixed . (\a -> [a]))+     [Amount dollar 1    (Just $ TotalPrice $ Mixed [euros 1])+     ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])+     ])+      `is` (Mixed [Amount dollar 1    (Just $ TotalPrice $ Mixed [euros 1])+                  ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])+                  ])    ,"showMixedAmount" ~: do     showMixedAmount (Mixed [dollars 1]) `is` "$1.00"

@@ -18,7 +18,8 @@ import Hledger.Utils  -nonsimplecommoditychars = "0123456789-.@;\n \""+-- characters than can't be in a non-quoted commodity symbol+nonsimplecommoditychars = "0123456789-.@;\n \"{}" :: String  quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\""                                | otherwise = s

@@ -1,3 +1,4 @@+{-# LANGUAGE NoMonoLocalBinds #-} {-|  Date parsing and utilities for hledger.

@@ -340,7 +340,7 @@            | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum)       bvmsg | isReallyZeroMixedAmountCost bvsum = ""             | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum)-      sep = if not (null rmsg) && not (null bvmsg) then "; " else ""+      sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String  transactionActualDate :: Transaction -> Day transactionActualDate = tdate@@ -455,12 +455,14 @@                             [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing,                              Posting False "b" (Mixed [dollars 1]) "" RegularPosting [] Nothing                             ] ""))+      assertBool "detect unbalanced entry, multiple missing amounts"                     (isLeft $ balanceTransaction Nothing                            (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" []                             [Posting False "a" missingmixedamt "" RegularPosting [] Nothing,                              Posting False "b" missingmixedamt "" RegularPosting [] Nothing                             ] ""))+      let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "" "" []                            [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing,                             Posting False "b" missingmixedamt "" RegularPosting [] Nothing@@ -471,6 +473,7 @@                      (case e of                         Right e' -> (pamount $ last $ tpostings e')                         Left _ -> error' "should not happen")+      let e = balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" []                            [Posting False "a" (Mixed [dollars 1.35]) "" RegularPosting [] Nothing,                             Posting False "b" (Mixed [euros   (-1)]) "" RegularPosting [] Nothing@@ -485,6 +488,18 @@                      (case e of                         Right e' -> (pamount $ head $ tpostings e')                         Left _ -> error' "should not happen")++     assertBool "balanceTransaction balances based on cost if there are unit prices" (isRight $+       balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" []+                           [Posting False "a" (Mixed [Amount dollar 1    (Just $ UnitPrice $ Mixed [euros 2])]) "" RegularPosting [] Nothing+                           ,Posting False "a" (Mixed [Amount dollar (-2) (Just $ UnitPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing+                           ] ""))++     assertBool "balanceTransaction balances based on cost if there are total prices" (isRight $+       balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" []+                           [Posting False "a" (Mixed [Amount dollar 1    (Just $ TotalPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing+                           ,Posting False "a" (Mixed [Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing+                           ] ""))    ,"isTransactionBalanced" ~: do      let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []

@@ -239,6 +239,7 @@   aname :: AccountName,     -- ^ this account's full name   aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts   asubs :: [Account],       -- ^ sub-accounts+  -- anumpostings :: Int       -- ^ number of postings to this account   -- derived from the above:   aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts   aparent :: Maybe Account, -- ^ parent account

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, NoMonoLocalBinds #-} {-|  A reader for hledger's journal file format@@ -488,6 +488,8 @@   account <- modifiedaccountname   let (ptype, account') = (accountNamePostingType account, unbracket account)   amount <- spaceandamountormissing+  _ <- balanceassertion+  _ <- fixedlotprice   many spacenonewline   (inlinecomment, inlinetag) <- inlinecomment   (nextlinecomments, nextlinetags) <- commentlines@@ -516,6 +518,9 @@      assertBool "posting parses a quoted commodity with numbers"       (isRight $ parseWithCtx nullctx posting "  a  1 \"DE123\"\n")++  ,"posting parses balance assertions and fixed lot prices" ~: do+    assertBool "" (isRight $ parseWithCtx nullctx posting "  a  1 \"DE123\" =$1 { =2.2 EUR} \n")  ]  -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.@@ -564,8 +569,8 @@     assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt  ] --- | Parse an amount, with an optional left or right currency symbol and--- optional price.+-- | Parse an amount, optionally with a left or right currency symbol,+-- price, and/or (ignored) ledger-style balance assertion. amount :: GenParser Char JournalContext MixedAmount amount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount @@ -654,6 +659,31 @@             many spacenonewline             a <- amount -- XXX can parse more prices ad infinitum, shouldn't             return $ Just $ UnitPrice a))+         <|> return Nothing++balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)+balanceassertion =+    try (do+          many spacenonewline+          char '='+          many spacenonewline+          a <- amount -- XXX should restrict to a simple amount+          return $ Just a)+         <|> return Nothing++-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices+fixedlotprice :: GenParser Char JournalContext (Maybe MixedAmount)+fixedlotprice =+    try (do+          many spacenonewline+          char '{'+          many spacenonewline+          char '='+          many spacenonewline+          a <- amount -- XXX should restrict to a simple amount+          many spacenonewline+          char '}'+          return $ Just a)          <|> return Nothing  -- | Parse a numeric quantity for its value and display attributes.  Some

@@ -55,7 +55,7 @@ uppercase = map toUpper  strip = lstrip . rstrip-lstrip = dropWhile (`elem` " \t")+lstrip = dropWhile (`elem` " \t") :: String -> String rstrip = reverse . lstrip . reverse  elideLeft width s =@@ -314,6 +314,12 @@   -- debugging++-- more:+-- http://hackage.haskell.org/packages/archive/TraceUtils/0.1.0.2/doc/html/Debug-TraceUtils.html+-- http://hackage.haskell.org/packages/archive/trace-call/0.1/doc/html/Debug-TraceCall.html+-- http://hackage.haskell.org/packages/archive/htrace/0.1/doc/html/Debug-HTrace.html+-- http://hackage.haskell.org/packages/archive/traced/2009.7.20/doc/html/Debug-Traced.html  -- | trace (print on stdout at runtime) a showable expression -- (for easily tracing in the middle of a complex expression)

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.19+version: 0.19.1 category:       Finance synopsis:       Core data types, parsers and utilities for the hledger accounting tool. description: