refactor: clarify that price amounts have only a single commodity
This commit is contained in:
		
							parent
							
								
									5a534f1c73
								
							
						
					
					
						commit
						64180b18ef
					
				| @ -72,6 +72,7 @@ module Hledger.Data.Amount ( | ||||
|   -- * MixedAmount | ||||
|   nullmixedamt, | ||||
|   missingmixedamt, | ||||
|   mixed, | ||||
|   amounts, | ||||
|   normaliseMixedAmountPreservingFirstPrice, | ||||
|   normaliseMixedAmountPreservingPrices, | ||||
| @ -162,11 +163,11 @@ sumAmounts = normaliseMixedAmountPreservingPrices . Mixed | ||||
| 
 | ||||
| -- | Set an amount's unit price. | ||||
| at :: Amount -> Amount -> Amount | ||||
| amt `at` priceamt = amt{aprice=UnitPrice $ Mixed [priceamt]} | ||||
| amt `at` priceamt = amt{aprice=UnitPrice priceamt} | ||||
| 
 | ||||
| -- | Set an amount's total price. | ||||
| (@@) :: Amount -> Amount -> Amount | ||||
| amt @@ priceamt = amt{aprice=TotalPrice $ Mixed [priceamt]} | ||||
| amt @@ priceamt = amt{aprice=TotalPrice priceamt} | ||||
| 
 | ||||
| tests_sumAmounts = [ | ||||
|   "sumAmounts" ~: do | ||||
| @ -189,9 +190,8 @@ costOfAmount :: Amount -> Amount | ||||
| costOfAmount a@Amount{aquantity=q, aprice=price} = | ||||
|     case price of | ||||
|       NoPrice -> a | ||||
|       UnitPrice  (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * q} | ||||
|       TotalPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * signum q} | ||||
|       _ -> error' "costOfAmount: Malformed price encountered, programmer error" | ||||
|       UnitPrice  p@Amount{aquantity=pq} -> p{aquantity=pq * q} | ||||
|       TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q} | ||||
| 
 | ||||
| -- | Divide an amount's quantity by a constant. | ||||
| divideAmount :: Amount -> Double -> Amount | ||||
| @ -244,13 +244,13 @@ showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice | ||||
| 
 | ||||
| showPrice :: Price -> String | ||||
| showPrice NoPrice         = "" | ||||
| showPrice (UnitPrice pa)  = " @ "  ++ showMixedAmount pa | ||||
| showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa | ||||
| showPrice (UnitPrice pa)  = " @ "  ++ showAmount pa | ||||
| showPrice (TotalPrice pa) = " @@ " ++ showAmount pa | ||||
| 
 | ||||
| showPriceDebug :: Price -> String | ||||
| showPriceDebug NoPrice         = "" | ||||
| showPriceDebug (UnitPrice pa)  = " @ "  ++ showMixedAmountDebug pa | ||||
| showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa | ||||
| showPriceDebug (UnitPrice pa)  = " @ "  ++ showAmountDebug pa | ||||
| showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa | ||||
| 
 | ||||
| -- | Get the string representation of an amount, based on its commodity's | ||||
| -- display settings. String representations equivalent to zero are | ||||
| @ -343,6 +343,9 @@ missingamt = amount{acommodity="AUTO"} | ||||
| missingmixedamt :: MixedAmount | ||||
| missingmixedamt = Mixed [missingamt] | ||||
| 
 | ||||
| mixed :: Amount -> MixedAmount | ||||
| mixed a = Mixed [a] | ||||
|    | ||||
| -- | 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. | ||||
| @ -510,9 +513,9 @@ tests_Hledger_Data_Amount = TestList $ | ||||
| 
 | ||||
|    "costOfAmount" ~: do | ||||
|     costOfAmount (eur 1) `is` eur 1 | ||||
|     costOfAmount (eur 2){aprice=UnitPrice $ Mixed [usd 2]} `is` usd 4 | ||||
|     costOfAmount (eur 1){aprice=TotalPrice $ Mixed [usd 2]} `is` usd 2 | ||||
|     costOfAmount (eur (-1)){aprice=TotalPrice $ Mixed [usd 2]} `is` usd (-2) | ||||
|     costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4 | ||||
|     costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2 | ||||
|     costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2) | ||||
| 
 | ||||
|   ,"isZeroAmount" ~: do | ||||
|     assertBool "" $ isZeroAmount $ amount | ||||
| @ -521,7 +524,7 @@ tests_Hledger_Data_Amount = TestList $ | ||||
|   ,"negating amounts" ~: do | ||||
|     let a = usd 1 | ||||
|     negate a `is` a{aquantity=(-1)} | ||||
|     let b = (usd 1){aprice=UnitPrice $ Mixed [eur 2]} | ||||
|     let b = (usd 1){aprice=UnitPrice $ eur 2} | ||||
|     negate b `is` b{aquantity=(-1)} | ||||
| 
 | ||||
|   ,"adding amounts without prices" ~: do | ||||
|  | ||||
| @ -296,8 +296,8 @@ balanceTransaction styles t@Transaction{tpostings=ps} | ||||
|                                         -- assign a balancing price. Use @@ for more exact output when possible. | ||||
|                                         -- invariant: prices should always be positive. Enforced with "abs" | ||||
|                                         = if length ramountsinunpricedcommodity == 1 | ||||
|                                            then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount] | ||||
|                                            else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)] | ||||
|                                            then TotalPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount | ||||
|                                            else UnitPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount) | ||||
|                                     | otherwise = NoPrice | ||||
|                       where | ||||
|                         unpricedcommodity     = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder | ||||
| @ -320,8 +320,8 @@ balanceTransaction styles t@Transaction{tpostings=ps} | ||||
|                 where | ||||
|                   conversionprice c | c == unpricedcommodity | ||||
|                                         = if length bvamountsinunpricedcommodity == 1 | ||||
|                                            then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount] | ||||
|                                            else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)] | ||||
|                                            then TotalPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount | ||||
|                                            else UnitPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount) | ||||
|                                     | otherwise = NoPrice | ||||
|                       where | ||||
|                         unpricedcommodity     = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder | ||||
|  | ||||
| @ -48,11 +48,8 @@ type Commodity = String | ||||
| type Quantity = Double | ||||
| 
 | ||||
| -- | An amount's price (none, per unit, or total) in another commodity. | ||||
| -- Note although a MixedAmount is used, it should be in a single | ||||
| -- commodity, also the amount should be positive; these are not enforced | ||||
| -- currently. | ||||
| data Price = NoPrice | UnitPrice MixedAmount | TotalPrice MixedAmount | ||||
|              deriving (Eq,Ord) | ||||
| -- Note the price should be a positive number, although this is not enforced. | ||||
| data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord) | ||||
| 
 | ||||
| -- | Display style for an amount. | ||||
| data AmountStyle = AmountStyle { | ||||
| @ -127,7 +124,7 @@ data TimeLogEntry = TimeLogEntry { | ||||
| data HistoricalPrice = HistoricalPrice { | ||||
|       hdate :: Day, | ||||
|       hsymbol :: String, | ||||
|       hamount :: MixedAmount | ||||
|       hamount :: Amount | ||||
|     } deriving (Eq) -- & Show (in Amount.hs) | ||||
| 
 | ||||
| type Year = Integer | ||||
|  | ||||
| @ -21,6 +21,7 @@ module Hledger.Read ( | ||||
|        accountname, | ||||
|        amountp, | ||||
|        amountp', | ||||
|        mamountp', | ||||
|        -- * Tests | ||||
|        samplejournal, | ||||
|        tests_Hledger_Read, | ||||
|  | ||||
| @ -427,7 +427,7 @@ transactionFromCsvRecord rules fields = | ||||
|       currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules) | ||||
|       amountstr'' = currency ++ amountstr' | ||||
|       amountparse = runParser amountp nullctx "" amountstr'' | ||||
|       a = either (const nullmixedamt) id amountparse | ||||
|       a = either (const nullmixedamt) mixed amountparse | ||||
|       -- Using costOfMixedAmount here to allow complex costs like "10 GBP @@ 15 USD". | ||||
|       -- Aim is to have "10 GBP @@ 15 USD" applied to account "acct", but have "-15USD" applied to "baseacct" | ||||
|       baseamount = costOfMixedAmount a | ||||
|  | ||||
| @ -29,6 +29,7 @@ module Hledger.Read.JournalReader ( | ||||
|   accountname, | ||||
|   amountp, | ||||
|   amountp', | ||||
|   mamountp', | ||||
|   emptyline, | ||||
|   -- * Tests | ||||
|   tests_Hledger_Read_JournalReader | ||||
| @ -254,11 +255,8 @@ defaultcommoditydirective :: GenParser Char JournalContext JournalUpdate | ||||
| defaultcommoditydirective = do | ||||
|   char 'D' <?> "default commodity" | ||||
|   many1 spacenonewline | ||||
|   a <- amountp | ||||
|   -- amount always returns a MixedAmount containing one Amount, but let's be safe | ||||
|   let as = amounts a  | ||||
|   when (not $ null as) $ | ||||
|     let Amount{..} = head as in setCommodityAndStyle (acommodity, astyle) | ||||
|   Amount{..} <- amountp | ||||
|   setCommodityAndStyle (acommodity, astyle) | ||||
|   restofline | ||||
|   return $ return id | ||||
| 
 | ||||
| @ -559,7 +557,7 @@ spaceandamountormissing :: GenParser Char JournalContext MixedAmount | ||||
| spaceandamountormissing = | ||||
|   try (do | ||||
|         many1 spacenonewline | ||||
|         amountp <|> return missingmixedamt | ||||
|         (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt | ||||
|       ) <|> return missingmixedamt | ||||
| 
 | ||||
| tests_spaceandamountormissing = [ | ||||
| @ -570,30 +568,35 @@ tests_spaceandamountormissing = [ | ||||
|     assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt | ||||
|  ] | ||||
| 
 | ||||
| -- | Parse an amount, optionally with a left or right currency symbol, | ||||
| -- price, and/or (ignored) ledger-style balance assertion. | ||||
| amountp :: GenParser Char JournalContext MixedAmount | ||||
| -- | Parse a single-commodity amount, with optional symbol on the left or | ||||
| -- right, optional unit or total price, and optional (ignored) | ||||
| -- ledger-style balance assertion or fixed lot price declaration. | ||||
| amountp :: GenParser Char JournalContext Amount | ||||
| amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount | ||||
| 
 | ||||
| tests_amountp = [ | ||||
|    "amountp" ~: do | ||||
|     assertParseEqual (parseWithCtx nullctx amountp "$47.18") (Mixed [usd 47.18]) | ||||
|     assertParseEqual (parseWithCtx nullctx amountp "$1.") (Mixed [setAmountPrecision 0 $ usd 1]) | ||||
|     assertParseEqual (parseWithCtx nullctx amountp "$47.18") (usd 47.18) | ||||
|     assertParseEqual (parseWithCtx nullctx amountp "$1.") (setAmountPrecision 0 $ usd 1) | ||||
|   ,"amount with unit price" ~: do | ||||
|     assertParseEqual | ||||
|      (parseWithCtx nullctx amountp "$10 @ €0.5") | ||||
|      (Mixed [usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)]) | ||||
|      (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) | ||||
|   ,"amount with total price" ~: do | ||||
|     assertParseEqual | ||||
|      (parseWithCtx nullctx amountp "$10 @@ €5") | ||||
|      (Mixed [usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)]) | ||||
|      (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)) | ||||
|  ] | ||||
| 
 | ||||
| -- | Run the amount parser on a string to get the result or an error. | ||||
| amountp' :: String -> MixedAmount | ||||
| -- | Parse an amount from a string, or get an error. | ||||
| amountp' :: String -> Amount | ||||
| amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s | ||||
| 
 | ||||
| leftsymbolamount :: GenParser Char JournalContext MixedAmount | ||||
| -- | Parse a mixed amount from a string, or get an error. | ||||
| mamountp' :: String -> MixedAmount | ||||
| mamountp' = mixed . amountp' | ||||
| 
 | ||||
| leftsymbolamount :: GenParser Char JournalContext Amount | ||||
| leftsymbolamount = do | ||||
|   sign <- optionMaybe $ string "-" | ||||
|   let applysign = if isJust sign then negate else id | ||||
| @ -602,20 +605,20 @@ leftsymbolamount = do | ||||
|   (q,prec,dec,sep,seppos) <- number | ||||
|   let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos} | ||||
|   p <- priceamount | ||||
|   return $ applysign $ Mixed [Amount c q p s] | ||||
|   return $ applysign $ Amount c q p s | ||||
|   <?> "left-symbol amount" | ||||
| 
 | ||||
| rightsymbolamount :: GenParser Char JournalContext MixedAmount | ||||
| rightsymbolamount :: GenParser Char JournalContext Amount | ||||
| rightsymbolamount = do | ||||
|   (q,prec,dec,sep,seppos) <- number | ||||
|   sp <- many spacenonewline | ||||
|   c <- commoditysymbol | ||||
|   p <- priceamount | ||||
|   let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos} | ||||
|   return $ Mixed [Amount c q p s] | ||||
|   return $ Amount c q p s | ||||
|   <?> "right-symbol amount" | ||||
| 
 | ||||
| nosymbolamount :: GenParser Char JournalContext MixedAmount | ||||
| nosymbolamount :: GenParser Char JournalContext Amount | ||||
| nosymbolamount = do | ||||
|   (q,prec,dec,sep,seppos) <- number | ||||
|   p <- priceamount | ||||
| @ -623,7 +626,7 @@ nosymbolamount = do | ||||
|   let (c,s) = case defcs of | ||||
|         Just (c',s') -> (c',s') | ||||
|         Nothing -> ("", amountstyle{asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}) | ||||
|   return $ Mixed [Amount c q p s] | ||||
|   return $ Amount c q p s | ||||
|   <?> "no-symbol amount" | ||||
| 
 | ||||
| commoditysymbol :: GenParser Char JournalContext String | ||||
| @ -655,7 +658,7 @@ priceamount = | ||||
|             return $ UnitPrice a)) | ||||
|          <|> return NoPrice | ||||
| 
 | ||||
| balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount) | ||||
| balanceassertion :: GenParser Char JournalContext (Maybe Amount) | ||||
| balanceassertion = | ||||
|     try (do | ||||
|           many spacenonewline | ||||
| @ -666,7 +669,7 @@ balanceassertion = | ||||
|          <|> return Nothing | ||||
| 
 | ||||
| -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices | ||||
| fixedlotprice :: GenParser Char JournalContext (Maybe MixedAmount) | ||||
| fixedlotprice :: GenParser Char JournalContext (Maybe Amount) | ||||
| fixedlotprice = | ||||
|     try (do | ||||
|           many spacenonewline | ||||
| @ -885,7 +888,7 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ | ||||
|      assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n") | ||||
| 
 | ||||
|   ,"historicalpricedirective" ~: | ||||
|     assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [usd 55]) | ||||
|     assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ usd 55) | ||||
| 
 | ||||
|   ,"ignoredpricecommoditydirective" ~: do | ||||
|      assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n") | ||||
| @ -910,16 +913,16 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ | ||||
|     assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:") | ||||
| 
 | ||||
|   ,"leftsymbolamount" ~: do | ||||
|     assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")  (Mixed [usd 1 `withPrecision` 0]) | ||||
|     assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (Mixed [usd (-1) `withPrecision` 0]) | ||||
|     assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (Mixed [usd (-1) `withPrecision` 0]) | ||||
|     assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")  (usd 1 `withPrecision` 0) | ||||
|     assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (usd (-1) `withPrecision` 0) | ||||
|     assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (usd (-1) `withPrecision` 0) | ||||
| 
 | ||||
|   ,"amount" ~: do | ||||
|      let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity | ||||
|          assertMixedAmountParse parseresult mixedamount = | ||||
|              (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) | ||||
|      assertMixedAmountParse (parseWithCtx nullctx amountp "1 @ $2") | ||||
|                             (Mixed [amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)]) | ||||
|      let -- | compare a parse result with an expected amount, showing the debug representation for clarity | ||||
|          assertAmountParse parseresult amount = | ||||
|              (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount) | ||||
|      assertAmountParse (parseWithCtx nullctx amountp "1 @ $2") | ||||
|        (amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)) | ||||
| 
 | ||||
|  ]] | ||||
| 
 | ||||
|  | ||||
| @ -61,7 +61,7 @@ import Text.ParserCombinators.Parsec | ||||
| import Text.Printf | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Read (amountp') | ||||
| import Hledger.Read (mamountp') | ||||
| import Hledger.Query | ||||
| import Hledger.Utils | ||||
| 
 | ||||
| @ -759,36 +759,36 @@ tests_accountsReport = | ||||
|   ,"accountsReport with no args on sample journal" ~: do | ||||
|    (defreportopts, samplejournal) `gives` | ||||
|     ([ | ||||
|       ("assets","assets",0, amountp' "$-1.00") | ||||
|      ,("assets:bank:saving","bank:saving",1, amountp' "$1.00") | ||||
|      ,("assets:cash","cash",1, amountp' "$-2.00") | ||||
|      ,("expenses","expenses",0, amountp' "$2.00") | ||||
|      ,("expenses:food","food",1, amountp' "$1.00") | ||||
|      ,("expenses:supplies","supplies",1, amountp' "$1.00") | ||||
|      ,("income","income",0, amountp' "$-2.00") | ||||
|      ,("income:gifts","gifts",1, amountp' "$-1.00") | ||||
|      ,("income:salary","salary",1, amountp' "$-1.00") | ||||
|      ,("liabilities:debts","liabilities:debts",0, amountp' "$1.00") | ||||
|       ("assets","assets",0, mamountp' "$-1.00") | ||||
|      ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00") | ||||
|      ,("assets:cash","cash",1, mamountp' "$-2.00") | ||||
|      ,("expenses","expenses",0, mamountp' "$2.00") | ||||
|      ,("expenses:food","food",1, mamountp' "$1.00") | ||||
|      ,("expenses:supplies","supplies",1, mamountp' "$1.00") | ||||
|      ,("income","income",0, mamountp' "$-2.00") | ||||
|      ,("income:gifts","gifts",1, mamountp' "$-1.00") | ||||
|      ,("income:salary","salary",1, mamountp' "$-1.00") | ||||
|      ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00") | ||||
|      ], | ||||
|      Mixed [nullamt]) | ||||
| 
 | ||||
|   ,"accountsReport with --depth=N" ~: do | ||||
|    (defreportopts{depth_=Just 1}, samplejournal) `gives` | ||||
|     ([ | ||||
|       ("assets",      "assets",      0, amountp' "$-1.00") | ||||
|      ,("expenses",    "expenses",    0, amountp'  "$2.00") | ||||
|      ,("income",      "income",      0, amountp' "$-2.00") | ||||
|      ,("liabilities", "liabilities", 0, amountp'  "$1.00") | ||||
|       ("assets",      "assets",      0, mamountp' "$-1.00") | ||||
|      ,("expenses",    "expenses",    0, mamountp'  "$2.00") | ||||
|      ,("income",      "income",      0, mamountp' "$-2.00") | ||||
|      ,("liabilities", "liabilities", 0, mamountp'  "$1.00") | ||||
|      ], | ||||
|      Mixed [nullamt]) | ||||
| 
 | ||||
|   ,"accountsReport with depth:N" ~: do | ||||
|    (defreportopts{query_="depth:1"}, samplejournal) `gives` | ||||
|     ([ | ||||
|       ("assets",      "assets",      0, amountp' "$-1.00") | ||||
|      ,("expenses",    "expenses",    0, amountp'  "$2.00") | ||||
|      ,("income",      "income",      0, amountp' "$-2.00") | ||||
|      ,("liabilities", "liabilities", 0, amountp'  "$1.00") | ||||
|       ("assets",      "assets",      0, mamountp' "$-1.00") | ||||
|      ,("expenses",    "expenses",    0, mamountp'  "$2.00") | ||||
|      ,("income",      "income",      0, mamountp' "$-2.00") | ||||
|      ,("liabilities", "liabilities", 0, mamountp'  "$1.00") | ||||
|      ], | ||||
|      Mixed [nullamt]) | ||||
| 
 | ||||
| @ -798,32 +798,32 @@ tests_accountsReport = | ||||
|      Mixed [nullamt]) | ||||
|    (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives` | ||||
|     ([ | ||||
|       ("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00") | ||||
|      ,("income:salary","income:salary",0,amountp' "$-1.00") | ||||
|       ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") | ||||
|      ,("income:salary","income:salary",0,mamountp' "$-1.00") | ||||
|      ], | ||||
|      Mixed [nullamt]) | ||||
| 
 | ||||
|   ,"accountsReport with desc:" ~: do | ||||
|    (defreportopts{query_="desc:income"}, samplejournal) `gives` | ||||
|     ([ | ||||
|       ("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00") | ||||
|      ,("income:salary","income:salary",0, amountp' "$-1.00") | ||||
|       ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") | ||||
|      ,("income:salary","income:salary",0, mamountp' "$-1.00") | ||||
|      ], | ||||
|      Mixed [nullamt]) | ||||
| 
 | ||||
|   ,"accountsReport with not:desc:" ~: do | ||||
|    (defreportopts{query_="not:desc:income"}, samplejournal) `gives` | ||||
|     ([ | ||||
|       ("assets","assets",0, amountp' "$-2.00") | ||||
|       ("assets","assets",0, mamountp' "$-2.00") | ||||
|      ,("assets:bank","bank",1, Mixed [nullamt]) | ||||
|      ,("assets:bank:checking","checking",2,amountp' "$-1.00") | ||||
|      ,("assets:bank:saving","saving",2, amountp' "$1.00") | ||||
|      ,("assets:cash","cash",1, amountp' "$-2.00") | ||||
|      ,("expenses","expenses",0, amountp' "$2.00") | ||||
|      ,("expenses:food","food",1, amountp' "$1.00") | ||||
|      ,("expenses:supplies","supplies",1, amountp' "$1.00") | ||||
|      ,("income:gifts","income:gifts",0, amountp' "$-1.00") | ||||
|      ,("liabilities:debts","liabilities:debts",0, amountp' "$1.00") | ||||
|      ,("assets:bank:checking","checking",2,mamountp' "$-1.00") | ||||
|      ,("assets:bank:saving","saving",2, mamountp' "$1.00") | ||||
|      ,("assets:cash","cash",1, mamountp' "$-2.00") | ||||
|      ,("expenses","expenses",0, mamountp' "$2.00") | ||||
|      ,("expenses:food","food",1, mamountp' "$1.00") | ||||
|      ,("expenses:supplies","supplies",1, mamountp' "$1.00") | ||||
|      ,("income:gifts","income:gifts",0, mamountp' "$-1.00") | ||||
|      ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00") | ||||
|      ], | ||||
|      Mixed [nullamt]) | ||||
| 
 | ||||
|  | ||||
| @ -527,7 +527,7 @@ handleAdd = do | ||||
|       acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M | ||||
|       acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M | ||||
|       amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt1M | ||||
|       amt2E = maybe (Right missingmixedamt)       (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M | ||||
|       amt2E = maybe (Right missingamt)       (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M | ||||
|       journalE = maybe (Right $ journalFilePath j) | ||||
|                        (\f -> let f' = unpack f in | ||||
|                               if f' `elem` journalFilePaths j | ||||
| @ -547,8 +547,8 @@ handleAdd = do | ||||
|                            tdate=parsedate date | ||||
|                           ,tdescription=desc | ||||
|                           ,tpostings=[ | ||||
|                             Posting False acct1 amt1 "" RegularPosting [] Nothing | ||||
|                            ,Posting False acct2 amt2 "" RegularPosting [] Nothing | ||||
|                             Posting False acct1 (mixed amt1) "" RegularPosting [] Nothing | ||||
|                            ,Posting False acct2 (mixed amt2) "" RegularPosting [] Nothing | ||||
|                            ] | ||||
|                           }) | ||||
|   -- display errors or add transaction | ||||
|  | ||||
| @ -17,7 +17,6 @@ import Data.Char (toUpper) | ||||
| import Data.List | ||||
| import Data.Maybe | ||||
| import Data.Time.Calendar | ||||
| import Safe (headMay) | ||||
| import System.Console.Haskeline (InputT, runInputT, defaultSettings, setComplete, getInputLine) | ||||
| import System.Console.Haskeline.Completion | ||||
| import System.IO ( stderr, hPutStrLn, hPutStr ) | ||||
| @ -148,22 +147,20 @@ getPostings st enteredps = do | ||||
|                 -- I think 1 or 4, whichever would show the most decimal places | ||||
|                 p = maxprecisionwithpoint | ||||
|       amountstr <- runInteractionDefault $ askFor (printf "amount  %d" n) defaultamountstr validateamount | ||||
|       let a  = fromparse $ runParser (amountp <|> return missingmixedamt) ctx     "" amountstr | ||||
|           a' = fromparse $ runParser (amountp <|> return missingmixedamt) nullctx "" amountstr | ||||
|           defaultamtused = Just (showMixedAmount a) == defaultamountstr | ||||
|           commodityadded | c == cwithnodef = Nothing | ||||
|                          | otherwise       = c | ||||
|               where c          = maybemixedamountcommodity a | ||||
|                     cwithnodef = maybemixedamountcommodity a' | ||||
|                     maybemixedamountcommodity = maybe Nothing (Just . acommodity) . headMay . amounts | ||||
|           p = nullposting{paccount=stripbrackets account, | ||||
|                           pamount=a, | ||||
|                           ptype=postingtype account} | ||||
|           st' = if defaultamtused then st | ||||
|                    else st{psHistory = historicalps', | ||||
|                            psSuggestHistoricalAmount = False} | ||||
|       when (isJust commodityadded) $ | ||||
|            liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust commodityadded) | ||||
|       let a  = fromparse $ runParser (amountp <|> return missingamt) ctx     "" amountstr | ||||
|           a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr | ||||
|           wasdefaultamtused = Just (showAmount a) == defaultamountstr | ||||
|           defaultcommodityadded | acommodity a == acommodity a' = Nothing | ||||
|                                 | otherwise                     = Just $ acommodity a | ||||
|           p = nullposting{paccount=stripbrackets account | ||||
|                          ,pamount=mixed a | ||||
|                          ,ptype=postingtype account | ||||
|                          } | ||||
|           st' = if wasdefaultamtused | ||||
|                  then st | ||||
|                  else st{psHistory=historicalps', psSuggestHistoricalAmount=False} | ||||
|       when (isJust defaultcommodityadded) $ | ||||
|            liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defaultcommodityadded) | ||||
|       getPostings st' (enteredps ++ [p]) | ||||
|     where | ||||
|       j = psJournal st | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user