parsing: support @@ syntax specifying total price

This commit is contained in:
Simon Michael 2011-01-15 02:04:53 +00:00
parent a95cf6369a
commit e03ada3bd3
9 changed files with 120 additions and 50 deletions

View File

@ -344,14 +344,20 @@ used for any subsequent amounts which have no commodity symbol.
You can specify a commodity's unit price or exchange rate, in terms of
another commodity. To set the price for a single posting's amount, write
`@ PRICE` after the amount, where PRICE is another amount in a different
commodity:
`@ UNITPRICE` after the amount, where UNITPRICE is the per-unit price in a
different commodity:
2009/1/2
assets:cash:foreign currency €100 @ $1.35 ; one hundred euros priced at $1.35 each
assets:cash
Or, you can set the price for a commodity as of a certain date, using a
Or, you can write `@@ TOTALPRICE`, which is sometimes more convenient:
2009/1/2
assets:cash:foreign currency €100 @@ $135 ; one hundred euros priced at $135 for the lot (equivalent to the above)
assets:cash
Or, you can set the price for this commodity as of a certain date, using a
historical price directive as shown here:
; the exchange rate for euro is $1.35 on 2009/1/1 (and thereafter, until a newer price directive is found)
@ -1231,7 +1237,6 @@ Here are some issues you might encounter when you run hledger:
[file format compatibility](#file-format-compatibility):
- AMOUNT1 = AMOUNT2 (balance assertion ? price specification ?)
- specifying prices with @@
- specifying prices via postings in different commodities
- comma decimal point and period thousands separator, or any number
format other than the US standard

View File

@ -60,9 +60,6 @@ instance Num Amount where
(-) = amountop (-)
(*) = amountop (*)
instance Ord Amount where
compare (Amount ac aq ap) (Amount bc bq bp) = compare (ac,aq,ap) (bc,bq,bp)
instance Num MixedAmount where
fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]
negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as
@ -71,9 +68,6 @@ instance Num MixedAmount where
abs = error' "programming error, mixed amounts do not support abs"
signum = error' "programming error, mixed amounts do not support signum"
instance Ord MixedAmount where
compare (Mixed as) (Mixed bs) = compare as bs
negateAmountPreservingPrice a = (-a){price=price a}
-- | Apply a binary arithmetic operator to two amounts, converting to the
@ -95,13 +89,26 @@ convertMixedAmountTo c2 (Mixed ams) = Amount c2 total Nothing
where
total = sum . map (quantity . convertAmountTo c2) $ ams
-- | Convert an amount to the commodity of its saved price, if any.
-- | Convert an amount to the commodity of its saved price, if any. Note
-- that although the price is a MixedAmount, only its first Amount is used.
costOfAmount :: Amount -> Amount
costOfAmount a@(Amount _ _ Nothing) = a
costOfAmount (Amount _ q (Just price))
| isZeroMixedAmount price = nullamt
| otherwise = Amount pc (pq*q) Nothing
where (Amount pc pq _) = head $ amounts price
costOfAmount a@(Amount _ q price)
| isNothing price = a
| isZeroMixedAmount up = nullamt
| otherwise = Amount pc (q*pq) Nothing
where
unitprice@(Just up) = priceAndQuantityToMaybeUnitPrice price q
(Amount pc pq _) =
case price of
Just (UnitPrice pa) -> head $ amounts pa
Just (TotalPrice _) -> head $ amounts $ fromJust unitprice
_ -> error "impossible case, programmer error"
-- | Convert a (unit or total) Price and quantity to a MixedAmount unit price.
priceAndQuantityToMaybeUnitPrice :: Maybe Price -> Double -> Maybe MixedAmount
priceAndQuantityToMaybeUnitPrice Nothing _ = Nothing
priceAndQuantityToMaybeUnitPrice (Just (UnitPrice a)) _ = Just a
priceAndQuantityToMaybeUnitPrice (Just (TotalPrice a)) q = Just $ a `divideMixedAmount` q
-- | Get the string representation of an amount, based on its commodity's
-- display settings.
@ -115,8 +122,15 @@ showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) =
sym' = quoteCommoditySymbolIfNeeded sym
space = if (spaced && not (null sym')) then " " else ""
quantity = showAmount' a
price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt
Nothing -> ""
price = maybe "" showPrice pri
showPrice :: Price -> String
showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa
showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa
showPriceDebug :: Price -> String
showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa
showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa
-- | Get the string representation of an amount, based on its commodity's
-- display settings except using the specified precision.
@ -129,7 +143,7 @@ setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}}
-- | Get the unambiguous string representation of an amount, for debugging.
showAmountDebug :: Amount -> String
showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}"
(show c) (show q) (maybe "" showMixedAmountDebug pri)
(show c) (show q) (maybe "" showPriceDebug pri)
-- | Get the string representation of an amount, without any \@ price.
showAmountWithoutPrice :: Amount -> String
@ -347,6 +361,14 @@ amountopPreservingHighestPrecision op a@(Amount ac@Commodity{precision=ap} _ _)
costOfMixedAmount :: MixedAmount -> MixedAmount
costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as
-- | Divide a mixed amount's quantities by some constant.
divideMixedAmount :: MixedAmount -> Double -> MixedAmount
divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as
-- | Divide an amount's quantity by some constant.
divideAmount :: Amount -> Double -> Amount
divideAmount a@Amount{quantity=q} d = a{quantity=q/d}
-- | The empty simple amount.
nullamt :: Amount
nullamt = Amount unknown 0 Nothing

View File

@ -21,11 +21,11 @@ quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" +
-- convenient amount and commodity constructors, for tests etc.
unknown = Commodity {symbol="", side=L,spaced=False,comma=False,precision=0}
dollar = Commodity {symbol="$", side=L,spaced=False,comma=False,precision=2}
euro = Commodity {symbol="EUR",side=L,spaced=False,comma=False,precision=2}
pound = Commodity {symbol="£", side=L,spaced=False,comma=False,precision=2}
hour = Commodity {symbol="h", side=R,spaced=False,comma=False,precision=1}
unknown = Commodity {symbol="", side=L,spaced=False,comma=False,precision=0}
dollar = Commodity {symbol="$",side=L,spaced=False,comma=False,precision=2}
euro = Commodity {symbol="",side=L,spaced=False,comma=False,precision=2}
pound = Commodity {symbol="£",side=L,spaced=False,comma=False,precision=2}
hour = Commodity {symbol="h",side=R,spaced=False,comma=False,precision=1}
dollars n = Amount dollar n Nothing
euros n = Amount euro n Nothing

View File

@ -268,7 +268,7 @@ journalApplyHistoricalPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = fixprice
fixprice a@Amount{price=Just _} = a
fixprice a@Amount{commodity=c} = a{price=journalHistoricalPriceFor j d c}
fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalHistoricalPriceFor j d c}
-- | Get the price for a commodity on the specified day from the price database, if known.
-- Does only one lookup step, ie will not look up the price of a price.
@ -307,8 +307,10 @@ journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amoun
-- | Get this amount's commodity and any commodities referenced in its price.
amountCommodities :: Amount -> [Commodity]
amountCommodities Amount{commodity=c,price=Nothing} = [c]
amountCommodities Amount{commodity=c,price=Just ma} = c:(concatMap amountCommodities $ amounts ma)
amountCommodities Amount{commodity=c,price=p} =
case p of Nothing -> [c]
Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
-- | Get all this journal's amounts, in the order parsed.
journalAmounts :: Journal -> [MixedAmount]

View File

@ -260,7 +260,7 @@ tests_Transaction = TestList [
])
(showTransaction
(txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" []
[Posting False "a" (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting [] Nothing
[Posting False "a" (Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting [] Nothing
,Posting False "b" missingamt "" RegularPosting [] Nothing
] ""))

View File

@ -60,15 +60,21 @@ data Commodity = Commodity {
spaced :: Bool, -- ^ should there be a space between symbol and quantity
comma :: Bool, -- ^ should thousands be comma-separated
precision :: Int -- ^ number of decimal places to display
} deriving (Eq,Show,Read,Ord)
} deriving (Eq,Ord,Show,Read)
-- | An amount's price may be written as @ unit price or @@ total price.
-- Note although Price has a MixedAmount, it should hold only
-- single-commodity amounts, cf costOfAmount.
data Price = UnitPrice MixedAmount | TotalPrice MixedAmount
deriving (Eq,Ord)
data Amount = Amount {
commodity :: Commodity,
quantity :: Double,
price :: Maybe MixedAmount -- ^ unit price/conversion rate for this amount at posting time
} deriving (Eq)
price :: Maybe Price -- ^ the price for this amount at posting time
} deriving (Eq,Ord)
newtype MixedAmount = Mixed [Amount] deriving (Eq)
newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord)
data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting
deriving (Eq,Show)

View File

@ -423,6 +423,7 @@ ledgerpostings = do
ls <- many1 $ try linebeginningwithspaces
let parses p = isRight . parseWithCtx ctx p
postinglines = filter (not . (ledgercommentline `parses`)) ls
-- group any metadata lines with the posting line above
postinglinegroups :: [String] -> [String]
postinglinegroups [] = []
postinglinegroups (pline:ls) = (unlines $ pline:mdlines):postinglinegroups rest
@ -532,15 +533,21 @@ quotedcommoditysymbol = do
simplecommoditysymbol :: GenParser Char JournalContext String
simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)
priceamount :: GenParser Char JournalContext (Maybe MixedAmount)
priceamount :: GenParser Char JournalContext (Maybe Price)
priceamount =
try (do
many spacenonewline
char '@'
many spacenonewline
a <- someamount -- XXX could parse more prices ad infinitum, shouldn't
return $ Just a
) <|> return Nothing
try (do
char '@'
many spacenonewline
a <- someamount -- XXX this could parse more prices ad infinitum, but shouldn't
return $ Just $ TotalPrice a)
<|> (do
many spacenonewline
a <- someamount -- XXX this could parse more prices ad infinitum, but shouldn't
return $ Just $ UnitPrice a))
<|> return Nothing
-- gawd.. trying to parse a ledger number without error:
@ -650,12 +657,28 @@ tests_JournalReader = TestList [
assertMixedAmountParse parseresult mixedamount =
(either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)
assertMixedAmountParse (parseWithCtx nullctx someamount "1 @ $2")
(Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])])
(Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])])
,"postingamount" ~: do
assertParseEqual (parseWithCtx nullctx postingamount " $47.18") (Mixed [dollars 47.18])
assertParseEqual (parseWithCtx nullctx postingamount " $1.")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])
,"postingamount with unit price" ~: do
assertParseEqual
(parseWithCtx nullctx postingamount " $10 @ €0.5")
(Mixed [Amount{commodity=dollar{precision=0},
quantity=10,
price=(Just $ UnitPrice $ Mixed [Amount{commodity=euro{precision=1},
quantity=0.5,
price=Nothing}])}])
,"postingamount with total price" ~: do
assertParseEqual
(parseWithCtx nullctx postingamount " $10 @@ €5")
(Mixed [Amount{commodity=dollar{precision=0},
quantity=10,
price=(Just $ TotalPrice $ Mixed [Amount{commodity=euro{precision=0},
quantity=5,
price=Nothing}])}])
,"leftsymbolamount" ~: do
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")

24
tests/amounts.test Normal file
View File

@ -0,0 +1,24 @@
# 1. a no-commodity amount with a unit price
bin/hledger -f - print
<<<
2010/1/1 x
a 1 @ $2
b
>>>
2010/01/01 x
a 1 @ $2
b -1 @ $2
# 2. with a total price
bin/hledger -f - print
<<<
2010/1/1 x
a 2 @@ $2
b
>>>
2010/01/01 x
a 2 @@ $2
b -2 @@ $2

View File

@ -1,12 +0,0 @@
# a no-commodity amount with a price should work
bin/hledger -f - print
<<<
2010/1/1 x
a 1 @ $2
b
>>>
2010/01/01 x
a 1 @ $2
b -1 @ $2