diff --git a/.gitignore b/.gitignore index e0dfd5fbd1d..3f9f7e948d3 100644 --- a/.gitignore +++ b/.gitignore @@ -36,6 +36,7 @@ TAGS /[0-9]* # *.j +*.sw[op] # haskell stuff *.dyn_hi @@ -43,11 +44,13 @@ TAGS *.hi *.p_o *.hp +.cabal-sandbox/ cabal-dev* cabal.project.local cabal.sandbox.config dist/ dist-newstyle/ +.ghc.environment.* /Shake /.shake.html .stack-work/ diff --git a/cabal.project b/cabal.project index f3846116bfd..e7e57fa28ac 100644 --- a/cabal.project +++ b/cabal.project @@ -3,3 +3,4 @@ packages: hledger-lib hledger-ui hledger-web hledger-api +constraints: brick >= 0.36 diff --git a/examples/multi-commodity.journal b/examples/multi-commodity.journal new file mode 100644 index 00000000000..63ff2d4f0d7 --- /dev/null +++ b/examples/multi-commodity.journal @@ -0,0 +1,15 @@ +2015-01-01 transaction 1 + 1:2:3 ( 1 + 1) + 1:2:3:4 (-1 - 1) + +2015-01-02 transaction 2 + 1 = 1 A + -1 B + 1:2 + +2015-01-03 transaction 3 + 1:2:3:4:5 1 A + 1 -1 A == -1 B + +2015-01-04 transaction 4 + 1:2 -1 A + 1 B + 1:2:3:4:5 1 A - 1 B = 2 A - 1 B diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index db910dfdcf0..7dd3e25e288 100644 --- a/hledger-api/hledger-api.hs +++ b/hledger-api/hledger-api.hs @@ -170,6 +170,8 @@ instance ToJSON AmountStyle where toJSON = genericToJSON defaultOptions instance ToJSON Side where toJSON = genericToJSON defaultOptions instance ToJSON DigitGroupStyle where toJSON = genericToJSON defaultOptions instance ToJSON MixedAmount where toJSON = genericToJSON defaultOptions +instance ToJSON BalanceAssertion where toJSON = genericToJSON defaultOptions +instance ToJSON AssertionFlags where toJSON = genericToJSON defaultOptions instance ToJSON Price where toJSON = genericToJSON defaultOptions instance ToJSON MarketPrice where toJSON = genericToJSON defaultOptions instance ToJSON PostingType where toJSON = genericToJSON defaultOptions @@ -213,6 +215,8 @@ instance ToSchema AmountStyle instance ToSchema Side instance ToSchema DigitGroupStyle instance ToSchema MixedAmount +instance ToSchema BalanceAssertion +instance ToSchema AssertionFlags instance ToSchema Price #if MIN_VERSION_swagger2(2,1,5) where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index f7d13c5d3f4..be9638f34f0 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -66,7 +66,7 @@ accountsFromPostings ps = let grouped = groupSort [(paccount p,pamount p) | p <- ps] counted = [(aname, length amts) | (aname, amts) <- grouped] - summed = [(aname, sumStrict amts) | (aname, amts) <- grouped] -- always non-empty + summed = [(aname, reduceMixedAmounts amts) | (aname, amts) <- grouped] -- always non-empty acctstree = accountTree "root" $ map fst summed acctswithnumps = mapAccounts setnumps acctstree where setnumps a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted} acctswithebals = mapAccounts setebalance acctswithnumps where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed} diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 28173738c4c..412a591734e 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -59,6 +59,7 @@ module Hledger.Data.Amount ( costOfAmount, divideAmount, multiplyAmount, + multiplyAmounts, amountValue, -- ** rendering amountstyle, @@ -90,6 +91,9 @@ module Hledger.Data.Amount ( costOfMixedAmount, divideMixedAmount, multiplyMixedAmount, + multiplyMixedAmounts, + combineMixedAmounts, + reduceMixedAmounts, averageMixedAmounts, isNegativeAmount, isNegativeMixedAmount, @@ -182,7 +186,7 @@ amt @@ priceamt = amt{aprice=TotalPrice priceamt} -- A zero result keeps the commodity of the second amount. -- The result's display style is that of the second amount, with -- precision set to the highest of either amount. --- Prices are ignored and discarded. +-- Prices and multiplier flags are ignored and discarded. -- Remember: the caller is responsible for ensuring both amounts have the same commodity. similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}} @@ -215,7 +219,18 @@ divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d} -- | Multiply an amount's quantity by a constant. multiplyAmount :: Amount -> Quantity -> Amount -multiplyAmount a@Amount{aquantity=q} d = a{aquantity=q*d} +multiplyAmount a@Amount{aquantity=q} m = a { aquantity = q * m } + +-- | Multiply an amount's quantity by another, retaining the metadata of the +-- second but the multiplier state of the first. +multiplyAmounts :: Amount -> Amount -> Amount +multiplyAmounts a m = case acommodity m of + "" -> a' + c -> a' { acommodity = c + , astyle = astyle m + , aprice = aprice m + } + where a' = multiplyAmount a $ aquantity m -- | Is this amount negative ? The price is ignored. isNegativeAmount :: Amount -> Bool @@ -249,7 +264,12 @@ withPrecision = flip setAmountPrecision -- appropriate to the current debug level. 9 shows maximum detail. showAmountDebug :: Amount -> String showAmountDebug Amount{acommodity="AUTO"} = "(missing)" -showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle) +showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s, amultiplier=%s}" + (show acommodity) + (show aquantity) + (showPriceDebug aprice) + (show astyle) + (show amultiplier) -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String @@ -471,14 +491,18 @@ normaliseHelper squashprices (Mixed as) _:_ -> last zeros _ -> nullamt (zeros, nonzeros) = partition isReallyZeroAmount $ - map sumSimilarAmountsUsingFirstPrice $ + map squashfn $ groupBy groupfn $ sortBy sortfn as + squashfn [] = nullamt + squashfn (a:as) + | amultiplier a = (foldl' (*) a as) { aprice = aprice a, amultiplier = True } + | otherwise = (foldl' (+) a as) { aprice = aprice a } sortfn | squashprices = compare `on` acommodity | otherwise = compare `on` \a -> (acommodity a, aprice a) - groupfn | squashprices = (==) `on` acommodity - | otherwise = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2 + groupfn | squashprices = (==) `on` \a -> (acommodity a, amultiplier a) + | otherwise = \a1 a2 -> ((==) `on` \a -> (acommodity a, amultiplier a)) a1 a2 && combinableprices a1 a2 combinableprices Amount{aprice=NoPrice} Amount{aprice=NoPrice} = True combinableprices Amount{aprice=UnitPrice p1} Amount{aprice=UnitPrice p2} = p1 == p2 @@ -490,13 +514,6 @@ normaliseHelper squashprices (Mixed as) normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True --- | Sum same-commodity amounts in a lossy way, applying the first --- price to the result and discarding any other prices. Only used as a --- rendering helper. -sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount -sumSimilarAmountsUsingFirstPrice [] = nullamt -sumSimilarAmountsUsingFirstPrice as = (sumStrict as){aprice=aprice $ head as} - -- -- | Sum same-commodity amounts. If there were different prices, set -- -- the price to a special marker indicating "various". Only used as a -- -- rendering helper. @@ -534,7 +551,30 @@ divideMixedAmount (Mixed as) d = Mixed $ map (`divideAmount` d) as -- | Multiply a mixed amount's quantities by a constant. multiplyMixedAmount :: MixedAmount -> Quantity -> MixedAmount -multiplyMixedAmount (Mixed as) d = Mixed $ map (`multiplyAmount` d) as +multiplyMixedAmount (Mixed as) m = Mixed $ map (`multiplyAmount` m) as + +-- | Multiply a mixed amount's quantities by an amount, potentially collapsing +-- multiple commodities into one if the multiplier explicitly lists one, as +-- was done previously by auto-postings. +multiplyMixedAmounts :: MixedAmount -> Amount -> MixedAmount +multiplyMixedAmounts (Mixed as) m = normaliseMixedAmount $ Mixed $ map (`multiplyAmounts` m) as + +-- | Join two mixed amounts by either multiplying or adding each component +-- `Amount` in the second according to its `amultiplier` state. Any multipliers +-- in the first will remain as such in the result. +combineMixedAmounts :: MixedAmount -> MixedAmount -> MixedAmount +combineMixedAmounts l r@(Mixed rs) = case partition amultiplier rs of + ([], _) -> r + (ms, as) -> reduceMixedAmounts [multiplyMixedAmounts l m | m <- ms] + Mixed as + +-- | Collapse a list of mixed amounts into a single sum, applying any multipliers +-- in the chain, and not leaking space. +reduceMixedAmounts :: [MixedAmount] -> MixedAmount +reduceMixedAmounts [] = nullmixedamt +reduceMixedAmounts (a:as) = foldl' combineOrAddMixedAmounts a as + where combineOrAddMixedAmounts l r + | any amultiplier $ amounts r = combineMixedAmounts l r + | otherwise = l + r -- | Calculate the average of some mixed amounts. averageMixedAmounts :: [MixedAmount] -> MixedAmount diff --git a/hledger-lib/Hledger/Data/Commodity.hs b/hledger-lib/Hledger/Data/Commodity.hs index 4e095c708c0..7e9e0e99f0b 100644 --- a/hledger-lib/Hledger/Data/Commodity.hs +++ b/hledger-lib/Hledger/Data/Commodity.hs @@ -12,7 +12,6 @@ are thousands separated by comma, significant decimal places and so on. module Hledger.Data.Commodity where -import Data.Char (isDigit) import Data.List import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) @@ -26,13 +25,10 @@ import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol -nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char] +nonsimplecommoditychars = "0123456789-+.@*;\n \"(){}=" :: [Char] isNonsimpleCommodityChar :: Char -> Bool -isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars - where - otherChars = "-+.@*;\n \"{}=" :: T.Text - textElem = T.any . (==) +isNonsimpleCommodityChar = flip elem nonsimplecommoditychars quoteCommoditySymbolIfNeeded s | T.any (isNonsimpleCommodityChar) s = "\"" <> s <> "\"" | otherwise = s diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index bf6986f1479..4ec98ed2217 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -494,11 +494,12 @@ journalFinalise t path txt assrt j@Journal{jfiles=fs} = j {jfiles = (path,txt) : reverse fs ,jlastreadtime = t ,jdeclaredaccounts = reverse $ jdeclaredaccounts j - ,jtxns = reverse $ jtxns j -- NOTE: see addTransaction + ,jtxns = reverse $ map filterMultipliers $ jtxns j -- NOTE: see addTransaction ,jtxnmodifiers = reverse $ jtxnmodifiers j -- NOTE: see addTransactionModifier ,jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction ,jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice }) + where filterMultipliers t = t { tpostings = map removeMultipliers $ tpostings t } journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions @@ -530,7 +531,22 @@ journalCheckBalanceAssertions j = -- | Check a posting's balance assertion and return an error if it -- fails. checkBalanceAssertion :: Posting -> MixedAmount -> Either String () -checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt +checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal = + foldl' fold (Right ()) amts0 + where fold (Right _) cass = checkBalanceAssertionCommodity p cass bal + fold err _ = err + amts = amounts $ baamount ass + amts0 = amts ++ case afexact (baflags ass) of + False -> [] + True -> map zero $ amounts $ filterMixedAmount (\a -> not $ elem (acommodity a) commodities) bal + commodities = map acommodity amts + zero a = a { aquantity = 0 } +checkBalanceAssertion _ _ = Right () + +-- | Check a component of a posting's balance assertion and return an +-- error if it fails. +checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String () +checkBalanceAssertionCommodity p ass amt | isReallyZeroAmount diff = Right () | True = Left err where assertedcomm = acommodity ass @@ -552,8 +568,8 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt (case ptransaction p of Nothing -> ":" -- shouldn't happen Just t -> printf " in %s:\nin transaction:\n%s" - (showGenericSourcePos pos) (chomp $ show t) :: String - where pos = snd $ fromJust $ pbalanceassertion p) + (showGenericSourcePos pos) (chomp $ T.unpack $ tdescription t) :: String + where pos = baposition $ fromJust $ pbalanceassertion p) (showPostingLine p) (showDate $ postingDate p) (T.unpack $ paccount p) -- XXX pack @@ -561,7 +577,6 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt (showAmount actualbal) (showAmount ass) (diffplus ++ showAmount diff) -checkBalanceAssertion _ _ = Right () -- | Fill in any missing amounts and check that all journal transactions -- balance, or return an error message. This is done after parsing all @@ -678,9 +693,24 @@ checkInferAndRegisterAmounts (Right oldTx) = do (fmap void . addToBalance) styles oldTx { tpostings = newPostings } where inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting - inferFromAssignment p = maybe (return p) - (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . fst) - $ pbalanceassertion p + inferFromAssignment p = do + let acc = paccount p + case pbalanceassertion p of + Just ba | afexact (baflags ba) -> do + diff <- setMixedBalance acc $ baamount ba + fullPosting diff p + Just ba | otherwise -> do + old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc + let amt = baamount ba + commodities = map acommodity $ amounts amt + diff <- setMixedBalance acc $ + amt + filterMixedAmount (\a -> not $ acommodity a `elem` commodities) (fromMaybe nullmixedamt old) + fullPosting diff p + Nothing -> return p + fullPosting amt p = return p + { pamount = amt + , porigin = Just $ originalPosting p + } -- | Adds a posting's amount to the posting's account balance and -- checks a possible balance assertion. Or if there is no amount, @@ -690,21 +720,19 @@ addAmountAndCheckBalance :: -> Posting -> CurrentBalancesModifier s Posting addAmountAndCheckBalance _ p | hasAmount p = do - newAmt <- addToBalance (paccount p) $ pamount p + newAmt <- addToBalance (paccount p) $ pamount $ removeMultipliers p assrt <- R.reader eAssrt lift $ when assrt $ ExceptT $ return $ checkBalanceAssertion p newAmt return p addAmountAndCheckBalance fallback p = fallback p --- | Sets an account's balance to a given amount and returns the --- difference of new and old amount. -setBalance :: AccountName -> Amount -> CurrentBalancesModifier s MixedAmount -setBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do +-- | Sets all commodities comprising an account's balance to the given +-- amounts and returns the difference from the previous balance. +setMixedBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount +setMixedBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do old <- HT.lookup bals acc - let new = Mixed $ (amt :) $ maybe [] - (filter ((/= acommodity amt) . acommodity) . amounts) old - HT.insert bals acc new - return $ maybe new (new -) old + HT.insert bals acc amt + return $ maybe amt (amt -) old -- | Adds an amount to an account's balance and returns the resulting balance. addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index cb0cc4d6bfa..fe7597609ae 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -15,6 +15,10 @@ module Hledger.Data.Posting ( nullposting, posting, post, + nullassertion, + assertion, + nullassertionflags, + assertionflags, -- * operations originalPosting, postingStatus, @@ -24,6 +28,7 @@ module Hledger.Data.Posting ( isEmptyPosting, isAssignment, hasAmount, + removeMultipliers, postingAllTags, transactionAllTags, relatedPostings, @@ -53,6 +58,7 @@ module Hledger.Data.Posting ( -- * rendering showPosting, -- * misc. + nullsourcepos, showComment, tests_Posting ) @@ -96,6 +102,25 @@ posting = nullposting post :: AccountName -> Amount -> Posting post acct amt = posting {paccount=acct, pamount=Mixed [amt]} +nullsourcepos :: GenericSourcePos +nullsourcepos = JournalSourcePos "" (1,1) + +nullassertion, assertion :: BalanceAssertion +nullassertion = BalanceAssertion + {baamount=nullmixedamt + ,baflags=AssertionFlags + {afexact=False + } + ,baposition=nullsourcepos + } +assertion = nullassertion + +nullassertionflags, assertionflags :: AssertionFlags +nullassertionflags = AssertionFlags + {afexact=False + } +assertionflags = nullassertionflags + -- Get the original posting, if any. originalPosting :: Posting -> Posting originalPosting p = fromMaybe p $ porigin p @@ -133,12 +158,15 @@ hasAmount = (/= missingmixedamt) . pamount isAssignment :: Posting -> Bool isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) +removeMultipliers :: Posting -> Posting +removeMultipliers p = p { pamount = filterMixedAmount (not . amultiplier) $ pamount p } + -- | Sorted unique account names referenced by these postings. accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . sort . map paccount sumPostings :: [Posting] -> MixedAmount -sumPostings = sumStrict . map pamount +sumPostings = reduceMixedAmounts . map (pamount . removeMultipliers) -- | Remove all prices of a posting removePrices :: Posting -> Posting diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 20ed70464a6..5ac764d17cf 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -77,9 +77,6 @@ showGenericSourcePos = \case GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")" JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")" -nullsourcepos :: GenericSourcePos -nullsourcepos = JournalSourcePos "" (1,1) - nulltransaction :: Transaction nulltransaction = Transaction { tindex=0, @@ -170,7 +167,7 @@ postingAsLines elideamount onelineamounts ps p = concat [ | postingblock <- postingblocks] where postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, " ", amount, assertion, samelinecomment] | amount <- shownAmounts] - assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . fst) $ pbalanceassertion p + assertion = maybe "" ((" = " ++) . showMixedAmountWithZeroCommodity . baamount) $ pbalanceassertion p statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p where -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned @@ -328,9 +325,9 @@ inferBalancingAmount update styles t@Transaction{tpostings=ps} where printerr s = intercalate "\n" [s, showTransactionUnelided t] (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t) - realsum = sumStrict $ map pamount amountfulrealps + realsum = reduceMixedAmounts $ map pamount amountfulrealps (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t) - bvsum = sumStrict $ map pamount amountfulbvps + bvsum = reduceMixedAmounts $ map pamount amountfulbvps inferamount p@Posting{ptype=RegularPosting} | not (hasAmount p) = updateAmount p realsum inferamount p@Posting{ptype=BalancedVirtualPosting} @@ -396,10 +393,10 @@ priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting) priceInferrerFor t pt = inferprice where postings = filter ((==pt).ptype) $ tpostings t - pmixedamounts = map pamount postings + pmixedamounts = map (pamount . removeMultipliers) postings pamounts = concatMap amounts pmixedamounts pcommodities = map acommodity pamounts - sumamounts = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price + sumamounts = amounts $ reduceMixedAmounts pmixedamounts sumcommodities = map acommodity sumamounts sumprices = filter (/=NoPrice) $ map aprice sumamounts caninferprices = length sumcommodities == 2 && null sumprices @@ -543,10 +540,8 @@ tests_Transaction = tests "Transaction" [ ," assets:checking" ,"" ] - ] - ,tests "showTransaction" [ - test "show a balanced transaction, no eliding" $ + ,test "show a balanced transaction, no eliding" $ (let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" [] [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t} ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t} diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 90952088b76..20f1813f810 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -99,12 +99,6 @@ tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) --tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where -- pdates p = catMaybes [pdate p, pdate2 p] -postingScale :: Posting -> Maybe Quantity -postingScale p = - case amounts $ pamount p of - [a] | amultiplier a -> Just $ aquantity a - _ -> Nothing - -- | Converts a 'TransactionModifier''s posting to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting"). tmPostingToFunction :: Posting -> (Posting -> Posting) @@ -112,15 +106,8 @@ tmPostingToFunction p' = \p -> renderPostingCommentDates $ p' { pdate = pdate p , pdate2 = pdate2 p - , pamount = amount' p + , pamount = pamount p `combineMixedAmounts` pamount p' } - where - amount' = case postingScale p' of - Nothing -> const $ pamount p' - Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n) - withAmountType amount (Mixed as) = case acommodity amount of - "" -> Mixed as - c -> Mixed [a{acommodity = c, astyle = astyle amount, aprice = aprice amount} | a <- as] renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' } diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index ee24fcf5231..5a5cf1242d0 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -214,7 +214,19 @@ instance Show Status where -- custom show.. bad idea.. don't do it.. show Pending = "!" show Cleared = "*" -type BalanceAssertion = Maybe (Amount, GenericSourcePos) +data BalanceAssertion = BalanceAssertion { + baamount :: MixedAmount, + baflags :: AssertionFlags, + baposition :: GenericSourcePos + } deriving (Eq,Show,Typeable,Data,Generic) + +instance NFData BalanceAssertion + +data AssertionFlags = AssertionFlags { + afexact :: Bool + } deriving (Eq,Show,Read,Typeable,Data,Generic) + +instance NFData AssertionFlags data Posting = Posting { pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's @@ -225,7 +237,7 @@ data Posting = Posting { pcomment :: Text, -- ^ this posting's comment lines, as a single non-indented multi-line string ptype :: PostingType, ptags :: [Tag], -- ^ tag names and values, extracted from the comment - pbalanceassertion :: BalanceAssertion, -- ^ optional: the expected balance in this commodity in the account after this posting + pbalanceassertion :: Maybe BalanceAssertion, -- ^ optional: the expected balance in this commodity in the account after this posting ptransaction :: Maybe Transaction, -- ^ this posting's parent transaction (co-recursive types). -- Tying this knot gets tedious, Maybe makes it easier/optional. porigin :: Maybe Posting -- ^ original posting if this one is result of any transformations (one level only) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index c760c3d3a91..242cb1675e5 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -67,10 +67,11 @@ module Hledger.Read.Common ( spaceandamountormissingp, amountp, amountp', + mamountp, mamountp', commoditysymbolp, priceamountp, - partialbalanceassertionp, + balanceassertionp, fixedlotpricep, numberp, fromRawNumber, @@ -505,21 +506,24 @@ spaceandamountormissingp = -- right, optional unit or total price, and optional (ignored) -- ledger-style balance assertion or fixed lot price declaration. amountp :: JournalParser m Amount -amountp = label "amount" $ do - amount <- amountwithoutpricep +amountp = amountismultiplierp False + +amountismultiplierp :: Bool -> JournalParser m Amount +amountismultiplierp mult = label "amount" $ do + amount <- amountwithoutpricep mult lift $ skipMany spacenonewline price <- priceamountp pure $ amount { aprice = price } -amountwithoutpricep :: JournalParser m Amount -amountwithoutpricep = do - (mult, sign) <- lift $ (,) <$> multiplierp <*> signp - leftsymbolamountp mult sign <|> rightornosymbolamountp mult sign +amountwithoutpricep :: Bool -> JournalParser m Amount +amountwithoutpricep mult = do + sign <- lift signp + leftsymbolamountp sign <|> rightornosymbolamountp sign where - leftsymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount - leftsymbolamountp mult sign = label "amount" $ do + leftsymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount + leftsymbolamountp sign = label "amount" $ do c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c commodityspaced <- lift $ skipMany' spacenonewline @@ -533,8 +537,8 @@ amountwithoutpricep = do let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} return $ Amount c (sign (sign2 q)) NoPrice s mult - rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount - rightornosymbolamountp mult sign = label "amount" $ do + rightornosymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount + rightornosymbolamountp sign = label "amount" $ do posBeforeNum <- getPosition ambiguousRawNum <- lift rawnumberp mExponent <- lift $ optional $ try exponentp @@ -581,16 +585,48 @@ amountp' s = Right amt -> amt Left err -> error' $ show err -- XXX should throwError +-- | Parse a multi-commodity amount, comprising of multiple single amounts +-- separated by commas surrounded by spaces. +mamountp :: JournalParser m MixedAmount +mamountp = label "mixed amount" $ do + opc <- option '+' $ do + c <- ops + lift (skipMany spacenonewline) + pure c + paren <- option False $ try $ do + char '(' + lift (skipMany spacenonewline) + pure True + amount <- if paren + then do + inner <- mamountp + lift (skipMany spacenonewline) + char ')' + pure inner + else do + inner <- amountismultiplierp $ opc == '*' + return $ Mixed [inner] + tail <- option nullmixedamt $ try $ do + lift (skipMany spacenonewline) + lookAhead $ try ops + mamountp + let op = case opc of + '-' -> negate + '*' -> Mixed . map (\a -> a { amultiplier = True }) . amounts + _ -> id + return $ reduceMixedAmounts [op amount, tail] + where ops = satisfy (`elem` ("+-*" :: String)) + -- | Parse a mixed amount from a string, or get an error. mamountp' :: String -> MixedAmount -mamountp' = Mixed . (:[]) . amountp' +mamountp' s = + case runParser (evalStateT (mamountp <* eof) mempty) "" (T.pack s) of + Right amt -> amt + Left err -> error' $ show err -- XXX should throwError signp :: Num a => TextParser m (a -> a) signp = char '-' *> pure negate <|> char '+' *> pure id <|> pure id -multiplierp :: TextParser m Bool -multiplierp = option False $ char '*' *> pure True - -- | This is like skipMany but it returns True if at least one element -- was skipped. This is helpful if you’re just using many to check if -- the resulting list is empty or not. @@ -621,30 +657,25 @@ priceamountp = option NoPrice $ do priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice lift (skipMany spacenonewline) - priceAmount <- amountwithoutpricep "amount (as a price)" + priceAmount <- amountwithoutpricep False "amount (as a price)" pure $ priceConstructor priceAmount -partialbalanceassertionp :: JournalParser m BalanceAssertion -partialbalanceassertionp = optional $ do - sourcepos <- try $ do - lift (skipMany spacenonewline) - sourcepos <- genericSourcePos <$> lift getPosition - char '=' - pure sourcepos +balanceassertionp :: JournalParser m BalanceAssertion +balanceassertionp = do + sourcepos <- genericSourcePos <$> lift getPosition + char '=' + exact <- optional $ try $ char '=' + let flags = AssertionFlags { + afexact = isJust exact + } lift (skipMany spacenonewline) - a <- amountp "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount - return (a, sourcepos) - --- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount) --- balanceassertion = --- try (do --- lift (skipMany spacenonewline) --- string "==" --- lift (skipMany spacenonewline) --- a <- amountp -- XXX should restrict to a simple amount --- return $ Just $ Mixed [a]) --- <|> return Nothing + a <- mamountp "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount + return BalanceAssertion + { baamount = a + , baflags = flags + , baposition = sourcepos + } -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices fixedlotpricep :: JournalParser m (Maybe Amount) @@ -1235,6 +1266,31 @@ tests_Common = tests "Common" [ } ] + ,tests "mamountp" [ + test "basic" $ expectParseEq mamountp "$47.18" $ Mixed [usd 47.18] + ,test "multiple commodities" $ expectParseEq mamountp "$47.18+€20,59" $ Mixed [ + amount{ + acommodity="$" + ,aquantity=47.18 + ,astyle=amountstyle{asprecision=2, asdecimalpoint=Just '.'} + } + ,amount{ + acommodity="€" + ,aquantity=20.59 + ,astyle=amountstyle{asprecision=2, asdecimalpoint=Just ','} + } + ] + ,test "same commodity multiple times" $ expectParseEq mamountp "$10 + $2 - $5-$2" $ Mixed [ + amount{ + acommodity="$" + ,aquantity=5 + ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} + } + ] + ,test "ledger-compatible expressions" $ expectParseEq mamountp "($47.18 - $7.13)" $ Mixed [usd 40.05] + ,test "nested parentheses" $ expectParseEq mamountp "($47.18 - ($20 + $7.13) + $5.05)" $ Mixed [usd 25.10] + ] + ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in tests "numberp" [ test "." $ expectParseEq p "0" (0, 0, Nothing, Nothing) diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 34dae98a000..bb3cf39e464 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -749,10 +749,15 @@ transactionFromCsvRecord sourcepos rules record = t tcomment = T.pack comment, tpreceding_comment_lines = T.pack precomment, tpostings = - [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=balance} + [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance} ,posting {paccount=account2, pamount=amount2, ptransaction=Just t} ] } + toAssertion (a, b) = BalanceAssertion{ + baamount = Mixed [a], + baflags = nullassertionflags, + baposition = b + } getAmountStr :: CsvRules -> CsvRecord -> Maybe String getAmountStr rules record = diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index c4024ef1515..3b80c09475a 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -555,8 +555,9 @@ postingp mTransactionYear = do return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift (skipMany spacenonewline) - amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp - massertion <- partialbalanceassertionp + amount <- option missingmixedamt $ mamountp + lift (skipMany spacenonewline) + massertion <- optional $ balanceassertionp _ <- fixedlotpricep lift (skipMany spacenonewline) (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear @@ -695,6 +696,8 @@ tests_JournalReader = tests "JournalReader" [ ,test "quoted commodity symbol with digits" $ expectParse (postingp Nothing) " a 1 \"DE123\"\n" ,test "balance assertion and fixed lot price" $ expectParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" + + ,test "balance assertion over entire contents of account" $ expectParse (postingp Nothing) " a $1 + £2 == $1 + £2\n" ] ,tests "transactionmodifierp" [ diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 36545471085..24fc0ccfa0e 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -182,11 +182,6 @@ maximum' :: Integral a => [a] -> a maximum' [] = 0 maximum' xs = maximumStrict xs --- | Strict version of sum that doesn’t leak space -{-# INLINABLE sumStrict #-} -sumStrict :: Num a => [a] -> a -sumStrict = foldl' (+) 0 - -- | Strict version of maximum that doesn’t leak space {-# INLINABLE maximumStrict #-} maximumStrict :: Ord a => [a] -> a diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index 11f3ca2c5a0..4da5f728da4 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -85,7 +85,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do balancingamt = negate $ sum $ map (\(_,_,_,b) -> normaliseMixedAmountSquashPricesForDisplay b) acctbals ps = [posting{paccount=a ,pamount=mixed [b] - ,pbalanceassertion=Just (b,nullsourcepos) + ,pbalanceassertion=Just assertion{ baamount = mixed [b] } } |(a,_,_,mb) <- acctbals ,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb @@ -93,7 +93,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do ++ [posting{paccount="equity:opening balances", pamount=balancingamt}] nps = [posting{paccount=a ,pamount=mixed [negate b] - ,pbalanceassertion=Just (b{aquantity=0}, nullsourcepos) + ,pbalanceassertion=Just assertion{ baamount = mixed [b{aquantity=0}] } } |(a,_,_,mb) <- acctbals ,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb diff --git a/site/contributors.md b/site/contributors.md index 1b489ce4a6b..fb05480f0e6 100644 --- a/site/contributors.md +++ b/site/contributors.md @@ -8,6 +8,7 @@ hledger is brought to you by: - Roman Cheplyaka - "chart" command, "add" command improvements - Michael Snoyman - some additions to the Yesod web interface - Marko Kocić - hlint cleanup +- Samuel May - amount expressions, assertion types Developers who have not yet signed the contributor agreement: diff --git a/site/doc/1.11/journal.md b/site/doc/1.11/journal.md index 477da729eea..3198588fa36 100644 --- a/site/doc/1.11/journal.md +++ b/site/doc/1.11/journal.md @@ -356,6 +356,38 @@ when an amountless posting is balanced using a price's commodity, or when -V is used.) If you find this causing problems, set the desired format with a commodity directive. +#### Amount Expressions + +An amount may also be comprised of multiple parts joined by basic +arithmetic operators; in this case, each individual value follows the +structure described above, while the joins allow: + +- addition, subtraction, and multiplication using the standard ASCII + operators (`+`, `-`, `*`), either adjacent to the amount(s) or + separated by spaces +- parenthesised (sub-)expressions, to be evaluated before any + operations outside them. Note, however, that all commodity symbols + must be attached to an amount inside the parentheses: `($10 * 0.2)` + works, `$(10 * 0.2)` does not. +- multiple commodities in the same expression + +Multiplication of commodities is handled a bit differently than may be +expected; if the amount to the right of the operator includes an +explicit commodity, that commodity replaces any to the left for +compatibility with [automated postings](#automated-postings). If that +right value includes multiple commodities itself (parenthesised to obey +the order of operations), the left value is multiplied by each +individually. + +As examples, with the value each expression simplifies to (if +applicable): + +`$47.18-$7.13` -> `$40.05` +`$47.18 - ($20 + $7.13)` -> `$20.05` +`$6.10 + £4.35 * 0.8 €` -> `$6.10 + 3.48 €` +`($6.10 + £4.35) * 0.8 €` -> `8.36 €` +`$6.10 * (£0.2 + 0.8 €)` -> `£1.22 + 4.88 €` + ### Virtual Postings When you parenthesise the account name in a posting, we call that a @@ -460,6 +492,28 @@ that no matter how many assertions you add, you can't be sure the account does not contain some unexpected commodity. (We'll add support for this kind of total balance assertion if there's demand.) + +The asserted balance checks only the amount(s) of each listed commodity's +balance within the (possibly larger) account balance. We could call this a +partial balance assertion. This is compatible with Ledger, and makes it +possible to make assertions about accounts containing multiple commodities +without needing to manually track every commodity the account contains. + +To instead assert a balance to the exclusion of all other commodities, use the +exact assertion form `==EXPECTEDBALANCE`. This ensures that the account does +not contain some unexpected commodity, or, equivalently, that the balance of +any unlisted commodities is 0. + +``` {.journal} +2013/1/1 + a $1 = $1 + b = $-1 + +2013/1/2 + a 1€ = $1 + 1€ + b -1€ = $-1 - 1€ +``` + #### Assertions and subaccounts Balance assertions do not count the balance from subaccounts; they check @@ -1242,9 +1296,14 @@ something.): ``` The posting amounts can be of the form `*N`, which means "the amount of -the matched transaction's first posting, multiplied by N". They can also -be ordinary fixed amounts. Fixed amounts with no commodity symbol will -be given the same commodity as the matched transaction's first posting. +the matching posting(s), multiplied by N". They can also be ordinary +fixed amounts (which are inserted unchanged) or [amount +expressions](#amount-expressions) headed by either (only the +multiplication to the left of the first addition or subtraction will be +applied to the posting value). + +Any postings in real transactions which attempt to use this +multiplication-headed form will ignore the value instead. This example adds a corresponding ([unbalanced](#virtual-postings)) budget posting to every transaction involving the `expenses:gifts` diff --git a/tests/journal/amount-expressions.test b/tests/journal/amount-expressions.test new file mode 100644 index 00000000000..fc278d2320c --- /dev/null +++ b/tests/journal/amount-expressions.test @@ -0,0 +1,238 @@ +#!/usr/bin/env shelltest +# 1. Compatibiltiy with the example in Ledger docs +hledger -f - print +<<< +2017-03-10 * KFC + Expenses:Food ($10.00 + $20.00) + Assets:Cash +>>> +2017/03/10 * KFC + Expenses:Food $30.00 + Assets:Cash + +>>>2 +>>>=0 + +# 2. Expressions don't require parentheses +hledger -f - print +<<< +2017-03-10 * KFC + Expenses:Food $10.00 + $20.00 + Assets:Cash +>>> +2017/03/10 * KFC + Expenses:Food $30.00 + Assets:Cash + +>>>2 +>>>=0 + +# 3. Subtraction is distributive +hledger -f - print +<<< +2018-01-01 + a $10 - $5 + $2 + $3 + b $10 - ($5 + $2) + $7 + c +>>> +2018/01/01 + a $10 + b $10 + c + +>>>2 +>>>=0 + +# 4. Expressions consider the default commodity +hledger -f - print +<<< +D $1,000.00 + +2018-01-01 + a $10 - 5 + b +>>> +2018/01/01 + a $5.00 + b + +>>>2 +>>>=0 + +# 5. Expressions enable multi-commodity postings +hledger -f - print +<<< +2018-01-01 + a:usd $10 + a:coupon 10 OMD + b -($10 + 10 OMD) +>>> +2018/01/01 + a:usd $10 + a:coupon 10 OMD + b $-10 + b -10 OMD + +>>>2 +>>>=0 + +# 6. Expressions enable multi-commodity assertions +hledger -f - stats +<<< +2018-01-01 + a:usd $10 + a:coupon 10 OMD + b + +2018-01-02 + b 0 = -$10 - 10 OMD +>>> /Transactions/ +>>>2 +>>>=0 + +# 7. Default commodities are treated alongside their explicit counterpart +hledger -f - print +<<< +D $1,000.00 + +2018-01-01 + a $10 + 2 - 4 CAD + b +>>> +2018/01/01 + a $12.00 + a -4 CAD + b + +>>>2 +>>>=0 + +# 8. Raw quantities can be multiplicands +hledger -f - print +<<< +2018-01-01 + a $10 * .2 + b +>>> +2018/01/01 + a $2 + b + +>>>2 +>>>=0 + +# 9. Multiplication respects order of operations +#TODO: Precision should probably consider multiplier values +hledger -f - print +<<< +2018-01-01 + a $10 + $4 * 2 - ($5 - $2) * .5 * 3 + $1.00 + b +>>> +2018/01/01 + a $14.50 + b + +>>>2 +>>>=0 + +# 10. Standard postings headed by multipliers drop them +hledger -f - print +<<< +2018-01-01 + a *-1 + $8 + b *1 - $8 +>>> +2018/01/01 + a $8 + b $-8 + +>>>2 +>>>=0 + +# 11. Auto-postings respect expressions +hledger -f - print --auto +<<< += a + c *-1 + $8 + d *1 - $8 + +2018-01-01 + a $5 + b +>>> +2018/01/01 + a $5 + c $3 + d $-3 + b + +>>>2 +>>>=0 + +# 12. Auto-postings respect typed multiplication +hledger -f - print --auto +<<< += a + c *-1 CAD + 8 CAD + d *1 CAD - 8 CAD + +2018-01-01 + a $5 + b +>>> +2018/01/01 + a $5 + c 3 CAD + d -3 CAD + b + +>>>2 +>>>=0 + +# 13. Multipliers can be distinguished from default commodities +hledger -f - print +<<< +D $1,000.00 + +2018-01-01 + a 5 * 2 + b -10 + +2018-01-02 + a 5 CAD * 2 + b -10 CAD + +2018-01-03 + a 5 CAD * $2 + b $-10 +>>> +2018/01/01 + a $10.00 + b $-10.00 + +2018/01/02 + a 10 CAD + b -10 CAD + +2018/01/03 + a $10.00 + b $-10.00 + +>>>2 +>>>=0 + +# 14. Multi-commodity multipliers +hledger -f - print +<<< +2018-01-01 + a 10 GBP * ($2 + 3 CAD) + b +>>> +2018/01/01 + a $20 + a 30 CAD + b + +>>>2 +>>>=0 diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index 0570ab983ce..5e7110f7790 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -308,3 +308,36 @@ hledger -f - stats >>> /Transactions/ >>>2 >>>=0 + +# 17. Exact assertions parse correctly +hledger -f - stats +<<< +2016/1/1 + a $1 + b + +2016/1/2 + a 1 zorkmids + b + +2016/1/3 + a == $1 + 1 zorkmids +>>> /Transactions/ +>>>2 +>>>=0 + +# 18. Exact assertions consider entire account +hledger -f - stats +<<< +2016/1/1 + a $1 + b + +2016/1/2 + a 1 zorkmids + b + +2016/1/3 + a 0 == $1 +>>>2 /balance assertion error.*line 10, column 15/ +>>>=1