parsing: support @@ syntax specifying total price

2011-01-15 02:04:53 +00:00 · 2011-01-15 02:04:53 +00:00 · e03ada3bd3
commit e03ada3bd3
parent a95cf6369a
9 changed files with 120 additions and 50 deletions
--- a/MANUAL.markdown
+++ b/MANUAL.markdown
@ -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
--- a/hledger-lib/Hledger/Data/Amount.hs
+++ b/hledger-lib/Hledger/Data/Amount.hs
@ -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
--- a/hledger-lib/Hledger/Data/Commodity.hs
+++ b/hledger-lib/Hledger/Data/Commodity.hs
@ -23,7 +23,7 @@ quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" +

 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}
+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}

--- a/hledger-lib/Hledger/Data/Journal.hs
+++ b/hledger-lib/Hledger/Data/Journal.hs
@ -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]
--- a/hledger-lib/Hledger/Data/Transaction.hs
+++ b/hledger-lib/Hledger/Data/Transaction.hs
@ -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
         ] ""))

--- a/hledger-lib/Hledger/Data/Types.hs
+++ b/hledger-lib/Hledger/Data/Types.hs
@ -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)
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@ -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 '@'
+          try (do
                char '@'
                many spacenonewline
-          a <- someamount -- XXX could parse more prices ad infinitum, shouldn't
-          return $ Just a
-          ) <|> return Nothing
+                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")
--- a/tests/amounts.test
+++ b/tests/amounts.test
@ -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
+
--- a/tests/commodityless-amount-with-price.test
+++ b/tests/commodityless-amount-with-price.test
@ -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
-