From d39040c6340e7d8ff7ebd4b5a10aafb70d2e247a Mon Sep 17 00:00:00 2001 From: "Christian G. Warden" Date: Tue, 30 May 2017 07:30:15 -0700 Subject: [PATCH] Add Support for Rewriting Multipler Postings Into Different Commodities (#557) When generating a new posting as a multiple of an existing posting, support conversion to a different commodity. For example, postings in hours can be used to generate postings in USD. Automatic transactions generated from rewrite rules use the commodity, amount style, and transaction price if the rewrite defines a commodity. --- bin/hledger-rewrite.hs | 9 ++- hledger-lib/Hledger/Data/Amount.hs | 2 +- hledger-lib/Hledger/Data/AutoTransaction.hs | 14 ++-- hledger-lib/Hledger/Data/Commodity.hs | 2 +- hledger-lib/Hledger/Data/Types.hs | 9 +-- hledger-lib/Hledger/Read/Common.hs | 15 ++++- tests/bin/rewrite.test | 74 +++++++++++++++++++++ 7 files changed, 107 insertions(+), 18 deletions(-) diff --git a/bin/hledger-rewrite.hs b/bin/hledger-rewrite.hs index 08a883694..6f47feb89 100755 --- a/bin/hledger-rewrite.hs +++ b/bin/hledger-rewrite.hs @@ -60,12 +60,15 @@ More: $ hledger rewrite -- [QUERY] --add-posting "ACCT AMTEXPR" ... $ hledger rewrite -- ^income --add-posting '(liabilities:tax) *.33' $ hledger rewrite -- expenses:gifts --add-posting '(budget:gifts) *-1"' +$ hledger rewrite -- ^income --add-posting '(budget:foreign currency) *0.25 JPY; diversify' ``` Argument for `--add-posting` option is a usual posting of transaction with an -exception for amount specification. More precisely you can use `'*'` (star -symbol) in place of currency to indicate that that this is a factor for an -amount of original matched posting. +exception for amount specification. More precisely, you can use `'*'` (star +symbol) before the amount to indicate that that this is a factor for an +amount of original matched posting. If the amount includes a commodity name, +the new posting amount will be in the new commodity; otherwise, it will be in +the matched posting amount's commodity. #### Re-write rules in a file diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 0679d4461..247ac8633 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -151,7 +151,7 @@ instance Num Amount where -- | The empty simple amount. amount, nullamt :: Amount -amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle} +amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle, amultiplier=False} nullamt = amount -- | A temporary value for parsed transactions which had no amount specified. diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs index 83fbe94d5..1a0119428 100644 --- a/hledger-lib/Hledger/Data/AutoTransaction.hs +++ b/hledger-lib/Hledger/Data/AutoTransaction.hs @@ -55,7 +55,7 @@ import Hledger.Query -- ping $1.00 -- -- --- >>> runModifierTransaction Any (ModifierTransaction "ping" ["pong" `post` amount{acommodity="*", aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} +-- >>> runModifierTransaction Any (ModifierTransaction "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} -- 0000/01/01 -- ping $2.00 -- pong $6.00 @@ -107,7 +107,7 @@ tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) wh postingScale :: Posting -> Maybe Quantity postingScale p = case amounts $ pamount p of - [a] | acommodity a == "*" -> Just $ aquantity a + [a] | amultiplier a -> Just $ aquantity a _ -> Nothing runModifierPosting :: Posting -> (Posting -> Posting) @@ -117,10 +117,12 @@ runModifierPosting p' = modifier where , pdate2 = pdate2 p , pamount = amount' p } - amount' = - case postingScale p' of - Nothing -> const $ pamount p' - Just n -> \p -> pamount p `divideMixedAmount` (1/n) + 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/Commodity.hs b/hledger-lib/Hledger/Data/Commodity.hs index 1674979b7..d6c1a733d 100644 --- a/hledger-lib/Hledger/Data/Commodity.hs +++ b/hledger-lib/Hledger/Data/Commodity.hs @@ -24,7 +24,7 @@ import Hledger.Utils -- characters that may not be used in a non-quoted commodity symbol -nonsimplecommoditychars = "0123456789-+.@;\n \"{}=" :: [Char] +nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char] quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) (T.unpack s) = "\"" <> s <> "\"" | otherwise = s diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 680b8f398..d6b326e5a 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -158,10 +158,11 @@ data Commodity = Commodity { instance NFData Commodity data Amount = Amount { - acommodity :: CommoditySymbol, - aquantity :: Quantity, - aprice :: Price, -- ^ the (fixed) price for this amount, if any - astyle :: AmountStyle + acommodity :: CommoditySymbol, + aquantity :: Quantity, + aprice :: Price, -- ^ the (fixed) price for this amount, if any + astyle :: AmountStyle, + amultiplier :: Bool -- ^ amount is a multipier for AutoTransactions } deriving (Eq,Ord,Typeable,Data,Generic) instance NFData Amount diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index b21940479..e0d1121a6 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -371,30 +371,39 @@ signp = do return $ case sign of Just '-' -> "-" _ -> "" +multiplierp :: TextParser m Bool +multiplierp = do + multiplier <- optional $ oneOf ("*" :: [Char]) + return $ case multiplier of Just '*' -> True + _ -> False + leftsymbolamountp :: Monad m => JournalStateParser m Amount leftsymbolamountp = do sign <- lift signp + m <- lift multiplierp c <- lift commoditysymbolp sp <- lift $ many spacenonewline (q,prec,mdec,mgrps) <- lift numberp let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} p <- priceamountp let applysign = if sign=="-" then negate else id - return $ applysign $ Amount c q p s + return $ applysign $ Amount c q p s m "left-symbol amount" rightsymbolamountp :: Monad m => JournalStateParser m Amount rightsymbolamountp = do + m <- lift multiplierp (q,prec,mdec,mgrps) <- lift numberp sp <- lift $ many spacenonewline c <- lift commoditysymbolp p <- priceamountp let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} - return $ Amount c q p s + return $ Amount c q p s m "right-symbol amount" nosymbolamountp :: Monad m => JournalStateParser m Amount nosymbolamountp = do + m <- lift multiplierp (q,prec,mdec,mgrps) <- lift numberp p <- priceamountp -- apply the most recently seen default commodity and style to this commodityless amount @@ -402,7 +411,7 @@ nosymbolamountp = do let (c,s) = case defcs of Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) prec}) Nothing -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) - return $ Amount c q p s + return $ Amount c q p s m "no-symbol amount" commoditysymbolp :: TextParser m CommoditySymbol diff --git a/tests/bin/rewrite.test b/tests/bin/rewrite.test index 5c6555e1f..4efba2448 100644 --- a/tests/bin/rewrite.test +++ b/tests/bin/rewrite.test @@ -49,6 +49,80 @@ >>>2 >>>=0 +# Add postings in another commodity +../../bin/hledger-rewrite -f- +<<< +2017/04/24 * 09:00-09:25 + (assets:unbilled:client1) 0.42h + +2017/04/25 * 10:00-11:15 + (assets:unbilled:client1) 1.25h + +2017/04/25 * 14:00-15:32 + (assets:unbilled:client2) 1.54h + +; billing rules += ^assets:unbilled:client1 + (assets:to bill:client1) *100.00 CAD + += ^assets:unbilled:client2 + (assets:to bill:client2) *150.00 CAD +>>> +2017/04/24 * 09:00-09:25 + (assets:unbilled:client1) 0.42h + (assets:to bill:client1) 42.00 CAD + +2017/04/25 * 10:00-11:15 + (assets:unbilled:client1) 1.25h + (assets:to bill:client1) 125.00 CAD + +2017/04/25 * 14:00-15:32 + (assets:unbilled:client2) 1.54h + (assets:to bill:client2) 231.00 CAD + +>>>2 +>>>=0 + + +# Add postings with prices +../../bin/hledger-rewrite -f- -B +<<< +2017/04/24 * 09:00-09:25 + (assets:unbilled:client1) 0.42h + +2017/04/25 * 10:00-11:15 + (assets:unbilled:client1) 1.25h + +2017/04/25 * 14:00-15:32 + (assets:unbilled:client2) 1.54h + +; billing rules += ^assets:unbilled:client1 + assets:to bill:client1 *1.00 hours @ $100.00 + income:consulting:client1 + += ^assets:unbilled:client2 + assets:to bill:client2 *1.00 hours @ $150.00 + income:consulting:client2 +>>> +2017/04/24 * 09:00-09:25 + (assets:unbilled:client1) 0.42h + assets:to bill:client1 $42.00 + income:consulting:client1 + +2017/04/25 * 10:00-11:15 + (assets:unbilled:client1) 1.25h + assets:to bill:client1 $125.00 + income:consulting:client1 + +2017/04/25 * 14:00-15:32 + (assets:unbilled:client2) 1.54h + assets:to bill:client2 $231.00 + income:consulting:client2 + +>>>2 +>>>=0 + # Add absolute bank processing fee ../../bin/hledger-rewrite -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee $5' --add-posting 'assets:bank $-5' <<<