first attempt at storing per-amount price
This commit is contained in:
		
							parent
							
								
									8e412b1be3
								
							
						
					
					
						commit
						33f06f334e
					
				| @ -48,45 +48,47 @@ instance Show Amount where show = showAmount | ||||
| instance Show MixedAmount where show = showMixedAmount | ||||
| 
 | ||||
| instance Num Amount where | ||||
|     abs (Amount c q) = Amount c (abs q) | ||||
|     signum (Amount c q) = Amount c (signum q) | ||||
|     fromInteger i = Amount (comm "") (fromInteger i) | ||||
|     abs (Amount c q p) = Amount c (abs q) p | ||||
|     signum (Amount c q p) = Amount c (signum q) p | ||||
|     fromInteger i = Amount (comm "") (fromInteger i) Nothing | ||||
|     (+) = amountop (+) | ||||
|     (-) = amountop (-) | ||||
|     (*) = amountop (*) | ||||
| 
 | ||||
| instance Num MixedAmount where | ||||
|     fromInteger i = Mixed [Amount (comm "") (fromInteger i)] | ||||
|     fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] | ||||
|     negate (Mixed as) = Mixed $ map negate as | ||||
|     (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ filter (not . isZeroAmount) $ as ++ bs | ||||
|     (*)    = error "programming error, mixed amounts do not support multiplication" | ||||
|     abs    = error "programming error, mixed amounts do not support abs" | ||||
|     signum = error "programming error, mixed amounts do not support signum" | ||||
| 
 | ||||
| -- | Apply a binary arithmetic operator to two amounts, converting | ||||
| -- to the second one's commodity and adopting the lowest | ||||
| -- precision. (Using the second commodity is best since sum and | ||||
| -- other folds start with a no-commodity amount.) | ||||
| -- | Apply a binary arithmetic operator to two amounts - converting to the | ||||
| -- second one's commodity, adopting the lowest precision, and discarding | ||||
| -- any price information. (Using the second commodity is best since sum | ||||
| -- and other folds start with a no-commodity amount.) | ||||
| amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount | ||||
| amountop op a@(Amount ac aq) b@(Amount bc bq) =  | ||||
|     Amount bc ((quantity $ convertAmountTo bc a) `op` bq) | ||||
| amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) =  | ||||
|     Amount bc ((quantity $ convertAmountTo bc a) `op` bq) Nothing | ||||
| 
 | ||||
| -- | Convert an amount to the specified commodity using the appropriate | ||||
| -- exchange rate (which is currently always 1). | ||||
| convertAmountTo :: Commodity -> Amount -> Amount | ||||
| convertAmountTo c2 (Amount c1 q) = Amount c2 (q * conversionRate c1 c2) | ||||
| convertAmountTo c2 (Amount c1 q p) = Amount c2 (q * conversionRate c1 c2) Nothing | ||||
| 
 | ||||
| -- | Get the string representation of an amount, based on its commodity's | ||||
| -- display settings. | ||||
| showAmount :: Amount -> String | ||||
| showAmount (Amount (Commodity {symbol=sym,side=side,spaced=spaced,comma=comma,precision=p}) q) | ||||
| showAmount (Amount (Commodity {symbol=sym,side=side,spaced=spaced,comma=comma,precision=p}) q pri) | ||||
|     | sym=="AUTO" = "" -- can display one of these in an error message | ||||
|     | side==L = printf "%s%s%s" sym space quantity | ||||
|     | side==R = printf "%s%s%s" quantity space sym | ||||
|     | side==L = printf "%s%s%s%s" sym space quantity price | ||||
|     | side==R = printf "%s%s%s%s" quantity space sym price | ||||
|     where  | ||||
|       space = if spaced then " " else "" | ||||
|       quantity = commad $ printf ("%."++show p++"f") q | ||||
|       commad = if comma then punctuatethousands else id | ||||
|       price = case pri of (Just pamt) -> " @ " ++ showMixedAmount pamt | ||||
|                           Nothing -> "" | ||||
| 
 | ||||
| -- | Add thousands-separating commas to a decimal number string | ||||
| punctuatethousands :: String -> String | ||||
| @ -101,7 +103,7 @@ punctuatethousands s = | ||||
| 
 | ||||
| -- | Does this amount appear to be zero when displayed with its given precision ? | ||||
| isZeroAmount :: Amount -> Bool | ||||
| isZeroAmount a@(Amount c _ ) = nonzerodigits == "" | ||||
| isZeroAmount a = nonzerodigits == "" | ||||
|     where nonzerodigits = filter (`elem` "123456789") $ showAmount a | ||||
| 
 | ||||
| -- | Access a mixed amount's components. | ||||
| @ -114,8 +116,7 @@ isZeroMixedAmount :: MixedAmount -> Bool | ||||
| isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount | ||||
| 
 | ||||
| -- | Get the string representation of a mixed amount, showing each of | ||||
| -- its component amounts. We currently display them on one line but | ||||
| -- will need to change to ledger's vertical layout. | ||||
| -- its component amounts. | ||||
| showMixedAmount :: MixedAmount -> String | ||||
| showMixedAmount m = concat $ intersperse ", " $ map show as | ||||
|     where (Mixed as) = normaliseMixedAmount m | ||||
| @ -142,5 +143,5 @@ nullamt = Mixed [] | ||||
| 
 | ||||
| -- | A temporary value for parsed transactions which had no amount specified. | ||||
| missingamt :: MixedAmount | ||||
| missingamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0}) 0] | ||||
| missingamt = Mixed [Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0}) 0 Nothing] | ||||
| 
 | ||||
|  | ||||
| @ -23,10 +23,10 @@ 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} | ||||
| 
 | ||||
| dollars  = Amount dollar | ||||
| euros    = Amount euro | ||||
| pounds   = Amount pound | ||||
| hours    = Amount hour | ||||
| dollars n = Amount dollar n Nothing | ||||
| euros n   = Amount euro n Nothing | ||||
| pounds n  = Amount pound n Nothing | ||||
| hours n   = Amount hour n Nothing | ||||
| 
 | ||||
| defaultcommodities = [dollar,  euro,  pound, hour, unknown] | ||||
| 
 | ||||
|  | ||||
| @ -305,17 +305,20 @@ transactionamount :: Parser MixedAmount | ||||
| transactionamount = | ||||
|   try (do | ||||
|         many1 spacenonewline | ||||
|         a <- try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount <|> return missingamt | ||||
|         a <- someamount <|> return missingamt | ||||
|         return a | ||||
|       ) <|> return missingamt | ||||
| 
 | ||||
| someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount  | ||||
| 
 | ||||
| leftsymbolamount :: Parser MixedAmount | ||||
| leftsymbolamount = do | ||||
|   sym <- commoditysymbol  | ||||
|   sp <- many spacenonewline | ||||
|   (q,p,comma) <- amountquantity | ||||
|   pri <- priceamount | ||||
|   let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p} | ||||
|   return $ Mixed [Amount c q] | ||||
|   return $ Mixed [Amount c q pri] | ||||
|   <?> "left-symbol amount" | ||||
| 
 | ||||
| rightsymbolamount :: Parser MixedAmount | ||||
| @ -323,20 +326,32 @@ rightsymbolamount = do | ||||
|   (q,p,comma) <- amountquantity | ||||
|   sp <- many spacenonewline | ||||
|   sym <- commoditysymbol | ||||
|   pri <- priceamount | ||||
|   let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p} | ||||
|   return $ Mixed [Amount c q] | ||||
|   return $ Mixed [Amount c q pri] | ||||
|   <?> "right-symbol amount" | ||||
| 
 | ||||
| nosymbolamount :: Parser MixedAmount | ||||
| nosymbolamount = do | ||||
|   (q,p,comma) <- amountquantity | ||||
|   pri <- priceamount | ||||
|   let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p} | ||||
|   return $ Mixed [Amount c q] | ||||
|   return $ Mixed [Amount c q pri] | ||||
|   <?> "no-symbol amount" | ||||
| 
 | ||||
| commoditysymbol :: Parser String | ||||
| commoditysymbol = many1 (noneOf "-.0123456789;\n ") <?> "commodity symbol" | ||||
| 
 | ||||
| priceamount :: Parser (Maybe MixedAmount) | ||||
| priceamount = | ||||
|     try (do | ||||
|           many spacenonewline | ||||
|           char '@' | ||||
|           many spacenonewline | ||||
|           a <- someamount | ||||
|           return $ Just a | ||||
|           ) <|> return Nothing | ||||
| 
 | ||||
| -- gawd.. trying to parse a ledger number without error: | ||||
| 
 | ||||
| -- | parse a ledger-style numeric quantity and also return the number of | ||||
|  | ||||
| @ -93,7 +93,7 @@ setAmountDisplayPrefs l@(RawLedger ms ps es f) = RawLedger ms ps (map fixEntryAm | ||||
|       fixEntryAmounts (Entry d s c de co ts pr) = Entry d s c de co (map fixRawTransactionAmounts ts) pr | ||||
|       fixRawTransactionAmounts (RawTransaction ac a c t) = RawTransaction ac (fixMixedAmount a) c t | ||||
|       fixMixedAmount (Mixed as) = Mixed $ map fixAmount as | ||||
|       fixAmount (Amount c q) = Amount (canonicalcommodity c) q | ||||
|       fixAmount (Amount c q pri) = Amount (canonicalcommodity c) q pri | ||||
|       canonicalcommodity c@(Commodity {symbol=s}) = | ||||
|           (firstoccurrenceof c){precision=maximum $ map precision $ commoditieswithsymbol s} | ||||
|       firstoccurrenceof Commodity{symbol=s} = head $ commoditieswithsymbol s | ||||
|  | ||||
| @ -31,7 +31,8 @@ data Commodity = Commodity { | ||||
| 
 | ||||
| data Amount = Amount { | ||||
|       commodity :: Commodity, | ||||
|       quantity :: Double | ||||
|       quantity :: Double, | ||||
|       price :: Maybe MixedAmount  -- ^ optional per-unit price for this amount at the time of entry | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| newtype MixedAmount = Mixed [Amount] deriving (Eq) | ||||
|  | ||||
							
								
								
									
										20
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										20
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -34,15 +34,15 @@ unittests = TestList [ | ||||
|   , | ||||
|   "amount arithmetic"   ~: do | ||||
|     let a1 = dollars 1.23 | ||||
|     let a2 = Amount (comm "$") (-1.23) | ||||
|     let a3 = Amount (comm "$") (-1.23) | ||||
|     assertequal (Amount (comm "$") 0) (a1 + a2) | ||||
|     assertequal (Amount (comm "$") 0) (a1 + a3) | ||||
|     assertequal (Amount (comm "$") (-2.46)) (a2 + a3) | ||||
|     assertequal (Amount (comm "$") (-2.46)) (a3 + a3) | ||||
|     assertequal (Amount (comm "$") (-2.46)) (sum [a2,a3]) | ||||
|     assertequal (Amount (comm "$") (-2.46)) (sum [a3,a3]) | ||||
|     assertequal (Amount (comm "$") 0) (sum [a1,a2,a3,-a3]) | ||||
|     let a2 = Amount (comm "$") (-1.23) Nothing | ||||
|     let a3 = Amount (comm "$") (-1.23) Nothing | ||||
|     assertequal (Amount (comm "$") 0 Nothing) (a1 + a2) | ||||
|     assertequal (Amount (comm "$") 0 Nothing) (a1 + a3) | ||||
|     assertequal (Amount (comm "$") (-2.46) Nothing) (a2 + a3) | ||||
|     assertequal (Amount (comm "$") (-2.46) Nothing) (a3 + a3) | ||||
|     assertequal (Amount (comm "$") (-2.46) Nothing) (sum [a2,a3]) | ||||
|     assertequal (Amount (comm "$") (-2.46) Nothing) (sum [a3,a3]) | ||||
|     assertequal (Amount (comm "$") 0 Nothing) (sum [a1,a2,a3,-a3]) | ||||
|   , | ||||
|   "ledgertransaction"  ~: do | ||||
|     assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str) | ||||
| @ -78,7 +78,7 @@ unittests = TestList [ | ||||
|   , | ||||
|   "transactionamount"       ~: do | ||||
|     assertparseequal (Mixed [dollars 47.18]) (parsewith transactionamount " $47.18") | ||||
|     assertparseequal (Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1]) (parsewith transactionamount " $1.") | ||||
|     assertparseequal (Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1 Nothing]) (parsewith transactionamount " $1.") | ||||
|   , | ||||
|   "setAmountDisplayPrefs" ~: do | ||||
|     let l = setAmountDisplayPrefs $ rawLedgerWithAmounts ["1","2.00"] | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user