Separate multiplier from Amount

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.

hledger-lib/Hledger/Data/Posting.hs

@@ -90,6 +90,7 @@ nullposting = Posting
                 ,pcomment=""
                 ,ptype=RegularPosting
                 ,ptags=[]
+                ,pmultiplier=Nothing
                 ,pbalanceassertion=Nothing
                 ,ptransaction=Nothing
                 ,porigin=Nothing

hledger-lib/Hledger/Data/TransactionModifier.hs

@@ -47,7 +47,7 @@ import Hledger.Utils.Debug
 -- 0000/01/01
 --     ping           $1.00
 -- <BLANKLINE>
--- >>> 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' }

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 "<txn>" <$> ptransaction))
     ,("porigin="           ++ show porigin)

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,18 +642,18 @@ 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
         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent
         -- 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
 

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" [

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"  $

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 ())