diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index a64876a1a37..ad414827f9b 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -166,7 +166,7 @@ instance Num Amount where -- | The empty simple amount. amount, nullamt :: Amount -amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle, amultiplier=False} +amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle} nullamt = amount -- | A temporary value for parsed transactions which had no amount specified. diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 48921c8da59..250486abedc 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -90,6 +90,7 @@ nullposting = Posting ,pcomment="" ,ptype=RegularPosting ,ptags=[] + ,pmultiplier=Nothing ,pbalanceassertion=Nothing ,ptransaction=Nothing ,porigin=Nothing diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 6eb9563388f..c49c43acf37 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -47,7 +47,7 @@ import Hledger.Utils.Debug -- 0000/01/01 -- ping $1.00 -- --- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} +-- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "ping" [nullposting{paccount="pong", pmultiplier=Just $ num 3}]) nulltransaction{tpostings=["ping" `post` usd 2]} -- 0000/01/01 -- ping $2.00 -- pong $6.00 @@ -86,33 +86,27 @@ tmPostingRuleToFunction pr = { pdate = pdate p , pdate2 = pdate2 p , pamount = amount' p + , pmultiplier = Nothing } where - amount' = case postingRuleMultiplier pr of + amount' = case pmultiplier pr of Nothing -> const $ pamount pr Just n -> \p -> -- Multiply the old posting's amount by the posting rule's multiplier. let - pramount = dbg6 "pramount" $ head $ amounts $ pamount pr matchedamount = dbg6 "matchedamount" $ pamount p -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928). -- Approach 1: convert to a unit price and increase the display precision slightly - -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount + -- Mixed as = dbg6 "multipliedamount" $ aquantity n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Approach 2: multiply the total price (keeping it positive) as well as the quantity - Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmountAndPrice` matchedamount + Mixed as = dbg6 "multipliedamount" $ aquantity n `multiplyMixedAmountAndPrice` matchedamount in - case acommodity pramount of + case acommodity n of "" -> Mixed as -- TODO multipliers with commodity symbols are not yet a documented feature. -- For now: in addition to multiplying the quantity, it also replaces the -- matched amount's commodity, display style, and price with those of the posting rule. - c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] - -postingRuleMultiplier :: TMPostingRule -> Maybe Quantity -postingRuleMultiplier p = - case amounts $ pamount p of - [a] | amultiplier a -> Just $ aquantity a - _ -> Nothing + c -> Mixed [a{acommodity = c, astyle = astyle n, aprice = aprice n} | 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 be289925539..473ae8afbc0 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -204,9 +204,7 @@ data Amount = Amount { acommodity :: CommoditySymbol, aquantity :: Quantity, aprice :: Price, -- ^ the (fixed) price for this amount, if any - astyle :: AmountStyle, - amultiplier :: Bool -- ^ kludge: a flag marking this amount and posting as a multiplier - -- in a TMPostingRule. In a regular Posting, should always be false. + astyle :: AmountStyle } deriving (Eq,Ord,Typeable,Data,Generic,Show) instance NFData Amount @@ -256,6 +254,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 + pmultiplier :: Maybe Amount, -- ^ optional: the proportion of the base value to use in a 'TransactionModifier' 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. @@ -271,7 +270,7 @@ instance NFData Posting -- identity, to avoid recuring ad infinitum. -- XXX could check that it's Just or Nothing. 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 j1 _ _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 _ _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2 && j1==j2 -- | Posting's show instance elides the parent transaction so as not to recurse forever. instance Show Posting where @@ -284,6 +283,7 @@ instance Show Posting where ,("pcomment=" ++ show pcomment) ,("ptype=" ++ show ptype) ,("ptags=" ++ show ptags) + ,("pmultiplier=" ++ show pmultiplier) ,("pbalanceassertion=" ++ show pbalanceassertion) ,("ptransaction=" ++ show (const "" <$> ptransaction)) ,("porigin=" ++ show porigin) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 90ed496681a..0fd604c807e 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -76,6 +76,7 @@ module Hledger.Read.Common ( priceamountp, balanceassertionp, fixedlotpricep, + multiplierp, numberp, fromRawNumber, rawnumberp, @@ -596,21 +597,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 = label "amount" $ amountormultiplierp False + +amountormultiplierp :: Bool -> JournalParser m Amount +amountormultiplierp isMultiplier = do + amount <- amountwithoutpricep isMultiplier 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 isMultiplier = 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 @@ -622,10 +626,10 @@ amountwithoutpricep = do let numRegion = (offBeforeNum, offAfterNum) (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} - return $ Amount c (sign (sign2 q)) NoPrice s mult + return $ Amount c (sign (sign2 q)) NoPrice s - rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount - rightornosymbolamountp mult sign = label "amount" $ do + rightornosymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount + rightornosymbolamountp sign = label "amount" $ do offBeforeNum <- getOffset ambiguousRawNum <- lift rawnumberp mExponent <- lift $ optional $ try exponentp @@ -638,7 +642,7 @@ amountwithoutpricep = do suggestedStyle <- getAmountStyle c (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} - return $ Amount c (sign q) NoPrice s mult + return $ Amount c (sign q) NoPrice s -- no symbol amount Nothing -> do suggestedStyle <- getDefaultAmountStyle @@ -646,10 +650,10 @@ amountwithoutpricep = do -- if a default commodity has been set, apply it and its style to this amount -- (unless it's a multiplier in an automated posting) defcs <- getDefaultCommodityAndStyle - let (c,s) = case (mult, defcs) of + let (c,s) = case (isMultiplier, defcs) of (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) - return $ Amount c (sign q) NoPrice s mult + return $ Amount c (sign q) NoPrice s -- For reducing code duplication. Doesn't parse anything. Has the type -- of a parser only in order to throw parse errors (for convenience). @@ -680,8 +684,14 @@ mamountp' = Mixed . (:[]) . amountp' 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 +-- | Parse a value used as a multiplier in a 'TransactionModifier' (a +-- @*@ character followed by a value following the rules of 'amountp', +-- except that it never takes the default commodity). +multiplierp :: JournalParser m Amount +multiplierp = label "multiplier" $ do + char '*' + lift $ skipMany spacenonewline + amountormultiplierp 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 @@ -713,7 +723,7 @@ 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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 58e052bd8b8..12ab670cedf 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -69,6 +69,7 @@ import Control.Monad import Control.Monad.Except (ExceptT(..)) import Control.Monad.State.Strict import Data.Bifunctor (first) +import Data.Either (fromLeft, fromRight) import Data.Maybe import qualified Data.Map.Strict as M import Data.Text (Text) @@ -483,7 +484,7 @@ transactionmodifierp = do lift (skipMany spacenonewline) querytxt <- lift $ T.strip <$> descriptionp (_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ? - postings <- postingsp Nothing + postings <- postingsp Nothing True return $ TransactionModifier querytxt postings -- | Parse a periodic transaction @@ -531,7 +532,7 @@ periodictransactionp = do ) -- next lines; use same year determined above - postings <- postingsp (Just $ first3 $ toGregorian refdate) + postings <- postingsp (Just $ first3 $ toGregorian refdate) False return $ nullperiodictransaction{ ptperiodexpr=periodtxt @@ -558,7 +559,7 @@ transactionp = do description <- lift $ T.strip <$> descriptionp (comment, tags) <- lift transactioncommentp let year = first3 $ toGregorian date - postings <- postingsp (Just year) + postings <- postingsp (Just year) False endpos <- getSourcePos let sourcepos = journalSourcePos startpos endpos return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings "" @@ -567,8 +568,8 @@ transactionp = do -- Parse the following whitespace-beginning lines as postings, posting -- tags, and/or comments (inferring year, if needed, from the given date). -postingsp :: Maybe Year -> JournalParser m [Posting] -postingsp mTransactionYear = many (postingp mTransactionYear) "postings" +postingsp :: Maybe Year -> Bool -> JournalParser m [Posting] +postingsp mTransactionYear allowCommodityMult = many (postingp mTransactionYear allowCommodityMult) "postings" -- linebeginningwithspaces :: JournalParser m String -- linebeginningwithspaces = do @@ -577,8 +578,8 @@ postingsp mTransactionYear = many (postingp mTransactionYear) "postings" -- cs <- lift restofline -- return $ sp ++ (c:cs) ++ "\n" -postingp :: Maybe Year -> JournalParser m Posting -postingp mTransactionYear = do +postingp :: Maybe Year -> Bool -> JournalParser m Posting +postingp mTransactionYear allowCommodityMult = do -- lift $ dbgparse 0 "postingp" (status, account) <- try $ do lift (skipSome spacenonewline) @@ -588,7 +589,10 @@ postingp mTransactionYear = do return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift (skipMany spacenonewline) - amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp + value <- (if allowCommodityMult + then (<|>) $ Left . Just <$> try multiplierp + else id + ) $ Right <$> (option missingmixedamt $ Mixed . (:[]) <$> amountp) lift (skipMany spacenonewline) massertion <- optional $ balanceassertionp _ <- fixedlotpricep @@ -599,10 +603,11 @@ postingp mTransactionYear = do , pdate2=mdate2 , pstatus=status , paccount=account' - , pamount=amount + , pamount=fromRight nullmixedamt value , pcomment=comment , ptype=ptype , ptags=tags + , pmultiplier=fromLeft Nothing value , pbalanceassertion=massertion } @@ -696,7 +701,7 @@ tests_JournalReader = tests "JournalReader" [ ] ,tests "postingp" [ - test "basic" $ expectParseEq (postingp Nothing) + test "basic" $ expectParseEq (postingp Nothing False) " expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" posting{ paccount="expenses:food:dining", @@ -705,7 +710,7 @@ tests_JournalReader = tests "JournalReader" [ ptags=[("a","a a"), ("b","b b")] } - ,test "posting dates" $ expectParseEq (postingp Nothing) + ,test "posting dates" $ expectParseEq (postingp Nothing False) " a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n" nullposting{ paccount="a" @@ -716,7 +721,7 @@ tests_JournalReader = tests "JournalReader" [ ,pdate2=Nothing -- Just $ fromGregorian 2012 11 29 } - ,test "posting dates bracket syntax" $ expectParseEq (postingp Nothing) + ,test "posting dates bracket syntax" $ expectParseEq (postingp Nothing False) " a 1. ; [2012/11/28=2012/11/29]\n" nullposting{ paccount="a" @@ -727,21 +732,28 @@ tests_JournalReader = tests "JournalReader" [ ,pdate2=Just $ fromGregorian 2012 11 29 } - ,test "quoted commodity symbol with digits" $ expectParse (postingp Nothing) " a 1 \"DE123\"\n" + ,test "quoted commodity symbol with digits" $ expectParse (postingp Nothing False) " 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 and fixed lot price" $ expectParse (postingp Nothing False) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" - ,test "balance assertion over entire contents of account" $ expectParse (postingp Nothing) " a $1 == $1\n" + ,test "balance assertion over entire contents of account" $ expectParse (postingp Nothing False) " a $1 == $1\n" ] ,tests "transactionmodifierp" [ - test "basic" $ expectParseEq transactionmodifierp + test "basic" $ expectParseEq transactionmodifierp "= (some value expr)\n some:postings 1.\n" nulltransactionmodifier { tmquerytxt = "(some value expr)" ,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}] } + + ,test "multiplier" $ expectParseEq transactionmodifierp + "= (some value expr)\n some:postings *.33\n" + nulltransactionmodifier { + tmquerytxt = "(some value expr)" + ,tmpostingrules = [nullposting{paccount="some:postings", pmultiplier=Just $ (num 0.33) {astyle=amountstyle{asprecision=2}}}] + } ] ,tests "transactionp" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 0ee1bf24820..e443c6a2b26 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -314,7 +314,7 @@ tests_MultiBalanceReports = tests "MultiBalanceReports" [ (map showw aitems) `is` (map showw eitems) ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals usd0 = usd 0 - amount0 = Amount {acommodity="$", aquantity=0, aprice=NoPrice, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, amultiplier=False} + amount0 = amount {acommodity="$", aquantity=0, astyle=amountstyle {asprecision = 2}} in tests "multiBalanceReport" [ test "null journal" $ diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 216393bcd2b..dbb56ec2846 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -195,7 +195,7 @@ transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} = ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts parseposting t = either (error' . errorBundlePretty) id ep where - ep = runIdentity (runJournalParser (postingp Nothing <* eof) t') + ep = runIdentity (runJournalParser (postingp Nothing True <* eof) t') t' = " " <> t <> "\n" -- inject space and newline for proper parsing printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())