slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: clarify that price amounts have only a single commodity

Browse Source
This commit is contained in:
Simon Michael 2012-11-19 23:17:55 +00:00
parent 5a534f1c73
commit 64180b18ef
9 changed files with 109 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
hledger-lib/Hledger/Data/Amount.hs
View File

@ -72,6 +72,7 @@ module Hledger.Data.Amount (
-- * MixedAmount -- * MixedAmount
nullmixedamt, nullmixedamt,
missingmixedamt, missingmixedamt,
mixed,
amounts, amounts,
normaliseMixedAmountPreservingFirstPrice, normaliseMixedAmountPreservingFirstPrice,
normaliseMixedAmountPreservingPrices, normaliseMixedAmountPreservingPrices,
@ -162,11 +163,11 @@ sumAmounts = normaliseMixedAmountPreservingPrices . Mixed
-- | Set an amount's unit price. -- | Set an amount's unit price.
at :: Amount -> Amount -> Amount 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. -- | Set an amount's total price.
(@@) :: Amount -> Amount -> Amount (@@) :: Amount -> Amount -> Amount
amt @@ priceamt = amt{aprice=TotalPrice $ Mixed [priceamt]} amt @@ priceamt = amt{aprice=TotalPrice priceamt}
tests_sumAmounts = [ tests_sumAmounts = [
"sumAmounts" ~: do "sumAmounts" ~: do
@ -189,9 +190,8 @@ costOfAmount :: Amount -> Amount
costOfAmount a@Amount{aquantity=q, aprice=price} = costOfAmount a@Amount{aquantity=q, aprice=price} =
case price of case price of
NoPrice -> a NoPrice -> a
UnitPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * q} UnitPrice p@Amount{aquantity=pq} -> p{aquantity=pq * q}
TotalPrice (Mixed [p@Amount{aquantity=pq}]) -> p{aquantity=pq * signum q} TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q}
_ -> error' "costOfAmount: Malformed price encountered, programmer error"
-- | Divide an amount's quantity by a constant. -- | Divide an amount's quantity by a constant.
divideAmount :: Amount -> Double -> Amount divideAmount :: Amount -> Double -> Amount
@ -244,13 +244,13 @@ showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice
showPrice :: Price -> String showPrice :: Price -> String
showPrice NoPrice = "" showPrice NoPrice = ""
showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa showPrice (UnitPrice pa) = " @ " ++ showAmount pa
showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa showPrice (TotalPrice pa) = " @@ " ++ showAmount pa
showPriceDebug :: Price -> String showPriceDebug :: Price -> String
showPriceDebug NoPrice = "" showPriceDebug NoPrice = ""
showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa
showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa
-- | Get the string representation of an amount, based on its commodity's -- | Get the string representation of an amount, based on its commodity's
-- display settings. String representations equivalent to zero are -- display settings. String representations equivalent to zero are
@ -343,6 +343,9 @@ missingamt = amount{acommodity="AUTO"}
missingmixedamt :: MixedAmount missingmixedamt :: MixedAmount
missingmixedamt = Mixed [missingamt] missingmixedamt = Mixed [missingamt]
mixed :: Amount -> MixedAmount
mixed a = Mixed [a]
-- | Simplify a mixed amount's component amounts: we can combine amounts -- | Simplify a mixed amount's component amounts: we can combine amounts
-- with the same commodity and unit price. Also remove any zero or missing -- 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. -- amounts and replace an empty amount list with a single zero amount.
@ -510,9 +513,9 @@ tests_Hledger_Data_Amount = TestList $
"costOfAmount" ~: do "costOfAmount" ~: do
costOfAmount (eur 1) `is` eur 1 costOfAmount (eur 1) `is` eur 1
costOfAmount (eur 2){aprice=UnitPrice $ Mixed [usd 2]} `is` usd 4 costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4
costOfAmount (eur 1){aprice=TotalPrice $ Mixed [usd 2]} `is` usd 2 costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2
costOfAmount (eur (-1)){aprice=TotalPrice $ Mixed [usd 2]} `is` usd (-2) costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2)
,"isZeroAmount" ~: do ,"isZeroAmount" ~: do
assertBool "" $ isZeroAmount $ amount assertBool "" $ isZeroAmount $ amount
@ -521,7 +524,7 @@ tests_Hledger_Data_Amount = TestList $
,"negating amounts" ~: do ,"negating amounts" ~: do
let a = usd 1 let a = usd 1
negate a `is` a{aquantity=(-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)} negate b `is` b{aquantity=(-1)}
,"adding amounts without prices" ~: do ,"adding amounts without prices" ~: do

8
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -296,8 +296,8 @@ balanceTransaction styles t@Transaction{tpostings=ps}
-- assign a balancing price. Use @@ for more exact output when possible. -- assign a balancing price. Use @@ for more exact output when possible.
-- invariant: prices should always be positive. Enforced with "abs" -- invariant: prices should always be positive. Enforced with "abs"
= if length ramountsinunpricedcommodity == 1 = if length ramountsinunpricedcommodity == 1
then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount] then TotalPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount
else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)] else UnitPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)
| otherwise = NoPrice | otherwise = NoPrice
where where
unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder
@ -320,8 +320,8 @@ balanceTransaction styles t@Transaction{tpostings=ps}
where where
conversionprice c | c == unpricedcommodity conversionprice c | c == unpricedcommodity
= if length bvamountsinunpricedcommodity == 1 = if length bvamountsinunpricedcommodity == 1
then TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount] then TotalPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount
else UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)] else UnitPrice $ setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)
| otherwise = NoPrice | otherwise = NoPrice
where where
unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder

9
hledger-lib/Hledger/Data/Types.hs
View File

@ -48,11 +48,8 @@ type Commodity = String
type Quantity = Double type Quantity = Double
-- | An amount's price (none, per unit, or total) in another commodity. -- | An amount's price (none, per unit, or total) in another commodity.
-- Note although a MixedAmount is used, it should be in a single -- Note the price should be a positive number, although this is not enforced.
-- commodity, also the amount should be positive; these are not enforced data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord)
-- currently.
data Price = NoPrice | UnitPrice MixedAmount | TotalPrice MixedAmount
deriving (Eq,Ord)
-- | Display style for an amount. -- | Display style for an amount.
data AmountStyle = AmountStyle { data AmountStyle = AmountStyle {
@ -127,7 +124,7 @@ data TimeLogEntry = TimeLogEntry {
data HistoricalPrice = HistoricalPrice { data HistoricalPrice = HistoricalPrice {
hdate :: Day, hdate :: Day,
hsymbol :: String, hsymbol :: String,
hamount :: MixedAmount hamount :: Amount
} deriving (Eq) -- & Show (in Amount.hs) } deriving (Eq) -- & Show (in Amount.hs)
type Year = Integer type Year = Integer

1
hledger-lib/Hledger/Read.hs
View File

@ -21,6 +21,7 @@ module Hledger.Read (
accountname, accountname,
amountp, amountp,
amountp', amountp',
mamountp',
-- * Tests -- * Tests
samplejournal, samplejournal,
tests_Hledger_Read, tests_Hledger_Read,

2
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -427,7 +427,7 @@ transactionFromCsvRecord rules fields =
currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules) currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)
amountstr'' = currency ++ amountstr' amountstr'' = currency ++ amountstr'
amountparse = runParser amountp nullctx "" 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". -- 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" -- Aim is to have "10 GBP @@ 15 USD" applied to account "acct", but have "-15USD" applied to "baseacct"
baseamount = costOfMixedAmount a baseamount = costOfMixedAmount a

67
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -29,6 +29,7 @@ module Hledger.Read.JournalReader (
accountname, accountname,
amountp, amountp,
amountp', amountp',
mamountp',
emptyline, emptyline,
-- * Tests -- * Tests
tests_Hledger_Read_JournalReader tests_Hledger_Read_JournalReader
@ -254,11 +255,8 @@ defaultcommoditydirective :: GenParser Char JournalContext JournalUpdate
defaultcommoditydirective = do defaultcommoditydirective = do
char 'D' <?> "default commodity" char 'D' <?> "default commodity"
many1 spacenonewline many1 spacenonewline
a <- amountp Amount{..} <- amountp
-- amount always returns a MixedAmount containing one Amount, but let's be safe setCommodityAndStyle (acommodity, astyle)
let as = amounts a
when (not $ null as) $
let Amount{..} = head as in setCommodityAndStyle (acommodity, astyle)
restofline restofline
return $ return id return $ return id
@ -559,7 +557,7 @@ spaceandamountormissing :: GenParser Char JournalContext MixedAmount
spaceandamountormissing = spaceandamountormissing =
try (do try (do
many1 spacenonewline many1 spacenonewline
amountp <|> return missingmixedamt (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
) <|> return missingmixedamt ) <|> return missingmixedamt
tests_spaceandamountormissing = [ tests_spaceandamountormissing = [
@ -570,30 +568,35 @@ tests_spaceandamountormissing = [
assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt
] ]
-- | Parse an amount, optionally with a left or right currency symbol, -- | Parse a single-commodity amount, with optional symbol on the left or
-- price, and/or (ignored) ledger-style balance assertion. -- right, optional unit or total price, and optional (ignored)
amountp :: GenParser Char JournalContext MixedAmount -- ledger-style balance assertion or fixed lot price declaration.
amountp :: GenParser Char JournalContext Amount
amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount
tests_amountp = [ tests_amountp = [
"amountp" ~: do "amountp" ~: do
assertParseEqual (parseWithCtx nullctx amountp "$47.18") (Mixed [usd 47.18]) assertParseEqual (parseWithCtx nullctx amountp "$47.18") (usd 47.18)
assertParseEqual (parseWithCtx nullctx amountp "$1.") (Mixed [setAmountPrecision 0 $ usd 1]) assertParseEqual (parseWithCtx nullctx amountp "$1.") (setAmountPrecision 0 $ usd 1)
,"amount with unit price" ~: do ,"amount with unit price" ~: do
assertParseEqual assertParseEqual
(parseWithCtx nullctx amountp "$10 @ €0.5") (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 ,"amount with total price" ~: do
assertParseEqual assertParseEqual
(parseWithCtx nullctx amountp "$10 @@ €5") (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. -- | Parse an amount from a string, or get an error.
amountp' :: String -> MixedAmount amountp' :: String -> Amount
amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s 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 leftsymbolamount = do
sign <- optionMaybe $ string "-" sign <- optionMaybe $ string "-"
let applysign = if isJust sign then negate else id let applysign = if isJust sign then negate else id
@ -602,20 +605,20 @@ leftsymbolamount = do
(q,prec,dec,sep,seppos) <- number (q,prec,dec,sep,seppos) <- number
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos} let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}
p <- priceamount p <- priceamount
return $ applysign $ Mixed [Amount c q p s] return $ applysign $ Amount c q p s
<?> "left-symbol amount" <?> "left-symbol amount"
rightsymbolamount :: GenParser Char JournalContext MixedAmount rightsymbolamount :: GenParser Char JournalContext Amount
rightsymbolamount = do rightsymbolamount = do
(q,prec,dec,sep,seppos) <- number (q,prec,dec,sep,seppos) <- number
sp <- many spacenonewline sp <- many spacenonewline
c <- commoditysymbol c <- commoditysymbol
p <- priceamount p <- priceamount
let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos} 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" <?> "right-symbol amount"
nosymbolamount :: GenParser Char JournalContext MixedAmount nosymbolamount :: GenParser Char JournalContext Amount
nosymbolamount = do nosymbolamount = do
(q,prec,dec,sep,seppos) <- number (q,prec,dec,sep,seppos) <- number
p <- priceamount p <- priceamount
@ -623,7 +626,7 @@ nosymbolamount = do
let (c,s) = case defcs of let (c,s) = case defcs of
Just (c',s') -> (c',s') Just (c',s') -> (c',s')
Nothing -> ("", amountstyle{asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}) 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" <?> "no-symbol amount"
commoditysymbol :: GenParser Char JournalContext String commoditysymbol :: GenParser Char JournalContext String
@ -655,7 +658,7 @@ priceamount =
return $ UnitPrice a)) return $ UnitPrice a))
<|> return NoPrice <|> return NoPrice
balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount) balanceassertion :: GenParser Char JournalContext (Maybe Amount)
balanceassertion = balanceassertion =
try (do try (do
many spacenonewline many spacenonewline
@ -666,7 +669,7 @@ balanceassertion =
<|> return Nothing <|> return Nothing
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -- 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 = fixedlotprice =
try (do try (do
many spacenonewline many spacenonewline
@ -885,7 +888,7 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n") assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n")
,"historicalpricedirective" ~: ,"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 ,"ignoredpricecommoditydirective" ~: do
assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n") 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:") assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:")
,"leftsymbolamount" ~: do ,"leftsymbolamount" ~: do
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (Mixed [usd 1 `withPrecision` 0]) assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (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") (Mixed [usd (-1) `withPrecision` 0]) assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (usd (-1) `withPrecision` 0)
,"amount" ~: do ,"amount" ~: do
let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity let -- | compare a parse result with an expected amount, showing the debug representation for clarity
assertMixedAmountParse parseresult mixedamount = assertAmountParse parseresult amount =
(either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount)
assertMixedAmountParse (parseWithCtx nullctx amountp "1 @ $2") assertAmountParse (parseWithCtx nullctx amountp "1 @ $2")
(Mixed [amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)]) (amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0))
]] ]]

64
hledger-lib/Hledger/Reports.hs
View File

@ -61,7 +61,7 @@ import Text.ParserCombinators.Parsec
import Text.Printf import Text.Printf
import Hledger.Data import Hledger.Data
import Hledger.Read (amountp') import Hledger.Read (mamountp')
import Hledger.Query import Hledger.Query
import Hledger.Utils import Hledger.Utils
@ -759,36 +759,36 @@ tests_accountsReport =
,"accountsReport with no args on sample journal" ~: do ,"accountsReport with no args on sample journal" ~: do
(defreportopts, samplejournal) `gives` (defreportopts, samplejournal) `gives`
([ ([
("assets","assets",0, amountp' "$-1.00") ("assets","assets",0, mamountp' "$-1.00")
,("assets:bank:saving","bank:saving",1, amountp' "$1.00") ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00")
,("assets:cash","cash",1, amountp' "$-2.00") ,("assets:cash","cash",1, mamountp' "$-2.00")
,("expenses","expenses",0, amountp' "$2.00") ,("expenses","expenses",0, mamountp' "$2.00")
,("expenses:food","food",1, amountp' "$1.00") ,("expenses:food","food",1, mamountp' "$1.00")
,("expenses:supplies","supplies",1, amountp' "$1.00") ,("expenses:supplies","supplies",1, mamountp' "$1.00")
,("income","income",0, amountp' "$-2.00") ,("income","income",0, mamountp' "$-2.00")
,("income:gifts","gifts",1, amountp' "$-1.00") ,("income:gifts","gifts",1, mamountp' "$-1.00")
,("income:salary","salary",1, amountp' "$-1.00") ,("income:salary","salary",1, mamountp' "$-1.00")
,("liabilities:debts","liabilities:debts",0, amountp' "$1.00") ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00")
], ],
Mixed [nullamt]) Mixed [nullamt])
,"accountsReport with --depth=N" ~: do ,"accountsReport with --depth=N" ~: do
(defreportopts{depth_=Just 1}, samplejournal) `gives` (defreportopts{depth_=Just 1}, samplejournal) `gives`
([ ([
("assets", "assets", 0, amountp' "$-1.00") ("assets", "assets", 0, mamountp' "$-1.00")
,("expenses", "expenses", 0, amountp' "$2.00") ,("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, amountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
,("liabilities", "liabilities", 0, amountp' "$1.00") ,("liabilities", "liabilities", 0, mamountp' "$1.00")
], ],
Mixed [nullamt]) Mixed [nullamt])
,"accountsReport with depth:N" ~: do ,"accountsReport with depth:N" ~: do
(defreportopts{query_="depth:1"}, samplejournal) `gives` (defreportopts{query_="depth:1"}, samplejournal) `gives`
([ ([
("assets", "assets", 0, amountp' "$-1.00") ("assets", "assets", 0, mamountp' "$-1.00")
,("expenses", "expenses", 0, amountp' "$2.00") ,("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, amountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
,("liabilities", "liabilities", 0, amountp' "$1.00") ,("liabilities", "liabilities", 0, mamountp' "$1.00")
], ],
Mixed [nullamt]) Mixed [nullamt])
@ -798,32 +798,32 @@ tests_accountsReport =
Mixed [nullamt]) Mixed [nullamt])
(defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives` (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0,amountp' "$-1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00")
], ],
Mixed [nullamt]) Mixed [nullamt])
,"accountsReport with desc:" ~: do ,"accountsReport with desc:" ~: do
(defreportopts{query_="desc:income"}, samplejournal) `gives` (defreportopts{query_="desc:income"}, samplejournal) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0, amountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00")
], ],
Mixed [nullamt]) Mixed [nullamt])
,"accountsReport with not:desc:" ~: do ,"accountsReport with not:desc:" ~: do
(defreportopts{query_="not:desc:income"}, samplejournal) `gives` (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","bank",1, Mixed [nullamt])
,("assets:bank:checking","checking",2,amountp' "$-1.00") ,("assets:bank:checking","checking",2,mamountp' "$-1.00")
,("assets:bank:saving","saving",2, amountp' "$1.00") ,("assets:bank:saving","saving",2, mamountp' "$1.00")
,("assets:cash","cash",1, amountp' "$-2.00") ,("assets:cash","cash",1, mamountp' "$-2.00")
,("expenses","expenses",0, amountp' "$2.00") ,("expenses","expenses",0, mamountp' "$2.00")
,("expenses:food","food",1, amountp' "$1.00") ,("expenses:food","food",1, mamountp' "$1.00")
,("expenses:supplies","supplies",1, amountp' "$1.00") ,("expenses:supplies","supplies",1, mamountp' "$1.00")
,("income:gifts","income:gifts",0, amountp' "$-1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00")
,("liabilities:debts","liabilities:debts",0, amountp' "$1.00") ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00")
], ],
Mixed [nullamt]) Mixed [nullamt])

6
hledger-web/Handler/Handlers.hs
View File

@ -527,7 +527,7 @@ handleAdd = do
acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M
acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M 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 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) journalE = maybe (Right $ journalFilePath j)
(\f -> let f' = unpack f in (\f -> let f' = unpack f in
if f' `elem` journalFilePaths j if f' `elem` journalFilePaths j
@ -547,8 +547,8 @@ handleAdd = do
tdate=parsedate date tdate=parsedate date
,tdescription=desc ,tdescription=desc
,tpostings=[ ,tpostings=[
Posting False acct1 amt1 "" RegularPosting [] Nothing Posting False acct1 (mixed amt1) "" RegularPosting [] Nothing
,Posting False acct2 amt2 "" RegularPosting [] Nothing ,Posting False acct2 (mixed amt2) "" RegularPosting [] Nothing
] ]
}) })
-- display errors or add transaction -- display errors or add transaction

31
hledger/Hledger/Cli/Add.hs
View File

@ -17,7 +17,6 @@ import Data.Char (toUpper)
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Time.Calendar import Data.Time.Calendar
import Safe (headMay)
import System.Console.Haskeline (InputT, runInputT, defaultSettings, setComplete, getInputLine) import System.Console.Haskeline (InputT, runInputT, defaultSettings, setComplete, getInputLine)
import System.Console.Haskeline.Completion import System.Console.Haskeline.Completion
import System.IO ( stderr, hPutStrLn, hPutStr ) 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 -- I think 1 or 4, whichever would show the most decimal places
p = maxprecisionwithpoint p = maxprecisionwithpoint
amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount
let a = fromparse $ runParser (amountp <|> return missingmixedamt) ctx "" amountstr let a = fromparse $ runParser (amountp <|> return missingamt) ctx "" amountstr
a' = fromparse $ runParser (amountp <|> return missingmixedamt) nullctx "" amountstr a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr
defaultamtused = Just (showMixedAmount a) == defaultamountstr wasdefaultamtused = Just (showAmount a) == defaultamountstr
commodityadded | c == cwithnodef = Nothing defaultcommodityadded | acommodity a == acommodity a' = Nothing
| otherwise = c | otherwise = Just $ acommodity a
where c = maybemixedamountcommodity a p = nullposting{paccount=stripbrackets account
cwithnodef = maybemixedamountcommodity a' ,pamount=mixed a
maybemixedamountcommodity = maybe Nothing (Just . acommodity) . headMay . amounts ,ptype=postingtype account
p = nullposting{paccount=stripbrackets account, }
pamount=a, st' = if wasdefaultamtused
ptype=postingtype account} then st
st' = if defaultamtused then st else st{psHistory=historicalps', psSuggestHistoricalAmount=False}
else st{psHistory = historicalps', when (isJust defaultcommodityadded) $
psSuggestHistoricalAmount = False} liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defaultcommodityadded)
when (isJust commodityadded) $
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust commodityadded)
getPostings st' (enteredps ++ [p]) getPostings st' (enteredps ++ [p])
where where
j = psJournal st j = psJournal st