refactor: move amount display settings out of commodity, simplify amount construction
This commit is contained in:
Simon Michael
parent
ae74983436
commit
4567e91409
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE StandaloneDeriving, RecordWildCards #-}
|
||||
{-|
|
||||
A simple 'Amount' is some quantity of money, shares, or anything else.
|
||||
It has a (possibly null) 'Commodity' and a numeric quantity:
|
||||
@ -43,30 +43,38 @@ exchange rates.
|
||||
|
||||
module Hledger.Data.Amount (
|
||||
-- * Amount
|
||||
amount,
|
||||
nullamt,
|
||||
missingamt,
|
||||
amt,
|
||||
usd,
|
||||
eur,
|
||||
gbp,
|
||||
hrs,
|
||||
at,
|
||||
(@@),
|
||||
amountWithCommodity,
|
||||
canonicaliseAmountCommodity,
|
||||
setAmountPrecision,
|
||||
-- ** arithmetic
|
||||
costOfAmount,
|
||||
divideAmount,
|
||||
sumAmounts,
|
||||
-- ** rendering
|
||||
amountstyle,
|
||||
showAmount,
|
||||
showAmountDebug,
|
||||
showAmountWithoutPrice,
|
||||
maxprecision,
|
||||
maxprecisionwithpoint,
|
||||
setAmountPrecision,
|
||||
withPrecision,
|
||||
canonicaliseAmount,
|
||||
canonicalStyles,
|
||||
-- * MixedAmount
|
||||
nullmixedamt,
|
||||
missingmixedamt,
|
||||
amounts,
|
||||
normaliseMixedAmountPreservingFirstPrice,
|
||||
normaliseMixedAmountPreservingPrices,
|
||||
canonicaliseMixedAmountCommodity,
|
||||
mixedAmountWithCommodity,
|
||||
setMixedAmountPrecision,
|
||||
-- ** arithmetic
|
||||
costOfMixedAmount,
|
||||
divideMixedAmount,
|
||||
@ -78,6 +86,8 @@ module Hledger.Data.Amount (
|
||||
showMixedAmountDebug,
|
||||
showMixedAmountWithoutPrice,
|
||||
showMixedAmountWithPrecision,
|
||||
setMixedAmountPrecision,
|
||||
canonicaliseMixedAmount,
|
||||
-- * misc.
|
||||
ltraceamount,
|
||||
tests_Hledger_Data_Amount
|
||||
@ -86,9 +96,10 @@ module Hledger.Data.Amount (
|
||||
import Data.Char (isDigit)
|
||||
import Data.List
|
||||
import Data.Map (findWithDefault)
|
||||
import Data.Ord (comparing)
|
||||
import Test.HUnit
|
||||
import Text.Printf
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.Commodity
|
||||
@ -97,52 +108,75 @@ import Hledger.Utils
|
||||
|
||||
deriving instance Show HistoricalPrice
|
||||
|
||||
amountstyle = AmountStyle L False 0 '.' ',' []
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Amount
|
||||
|
||||
instance Show Amount where show = showAmountDebug
|
||||
|
||||
instance Num Amount where
|
||||
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
|
||||
negate a@Amount{quantity=q} = a{quantity=(-q)}
|
||||
(+) = similarAmountsOp (+)
|
||||
(-) = similarAmountsOp (-)
|
||||
(*) = similarAmountsOp (*)
|
||||
abs a@Amount{aquantity=q} = a{aquantity=abs q}
|
||||
signum a@Amount{aquantity=q} = a{aquantity=signum q}
|
||||
fromInteger i = nullamt{aquantity=fromInteger i}
|
||||
negate a@Amount{aquantity=q} = a{aquantity=(-q)}
|
||||
(+) = similarAmountsOp (+)
|
||||
(-) = similarAmountsOp (-)
|
||||
(*) = similarAmountsOp (*)
|
||||
|
||||
-- | The empty simple amount.
|
||||
nullamt :: Amount
|
||||
nullamt = Amount unknown 0 Nothing
|
||||
amount :: Amount
|
||||
amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle}
|
||||
nullamt = amount
|
||||
|
||||
-- | Apply a binary arithmetic operator to two amounts, ignoring and
|
||||
-- discarding any assigned prices, and converting the first to the
|
||||
-- commodity of the second in a simplistic way (1-1 exchange rate).
|
||||
-- The highest precision of either amount is preserved in the result.
|
||||
-- handy amount constructors for tests
|
||||
amt n = amount{acommodity="", aquantity=n}
|
||||
usd n = amount{acommodity="$", aquantity=n, astyle=amountstyle{asprecision=2}}
|
||||
eur n = amount{acommodity="€", aquantity=n, astyle=amountstyle{asprecision=2}}
|
||||
gbp n = amount{acommodity="£", aquantity=n, astyle=amountstyle{asprecision=2}}
|
||||
hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R}}
|
||||
|
||||
-- | Apply a binary arithmetic operator to two amounts in the same
|
||||
-- commodity. Warning, as a kludge to support folds (eg sum) we assign
|
||||
-- the second's commodity to the first so the same commodity requirement
|
||||
-- is not checked. The highest precision of either amount is preserved in
|
||||
-- the result. Any prices are currently ignored and discarded. The display
|
||||
-- style is that of the first amount, with precision set to the highest of
|
||||
-- either amount.
|
||||
similarAmountsOp :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
|
||||
similarAmountsOp op a@(Amount Commodity{precision=ap} _ _) (Amount bc@Commodity{precision=bp} bq _) =
|
||||
Amount bc{precision=max ap bp} (quantity (amountWithCommodity bc a) `op` bq) Nothing
|
||||
similarAmountsOp op Amount{acommodity=_, aquantity=aq, astyle=AmountStyle{asprecision=ap}}
|
||||
Amount{acommodity=bc, aquantity=bq, astyle=bs@AmountStyle{asprecision=bp}} =
|
||||
-- trace ("a:"++showAmount a) $ trace ("b:"++showAmount b++"\n") $ tracewith (("=:"++).showAmount)
|
||||
amount{acommodity=bc, aquantity=aq `op` bq, astyle=bs{asprecision=max ap bp}}
|
||||
-- | ac==bc = amount{acommodity=ac, aquantity=aq `op` bq, astyle=as{asprecision=max ap bp}}
|
||||
-- | otherwise = error "tried to do simple arithmetic with amounts in different commodities"
|
||||
|
||||
-- | Convert an amount to the specified commodity, ignoring and discarding
|
||||
-- any assigned prices and assuming an exchange rate of 1.
|
||||
amountWithCommodity :: Commodity -> Amount -> Amount
|
||||
amountWithCommodity c (Amount _ q _) = Amount c q Nothing
|
||||
amountWithCommodity c a = a{acommodity=c, aprice=Nothing}
|
||||
|
||||
-- | A more complete amount adding operation.
|
||||
sumAmounts :: [Amount] -> MixedAmount
|
||||
sumAmounts = normaliseMixedAmountPreservingPrices . Mixed
|
||||
|
||||
-- | Set an amount's unit price.
|
||||
at :: Amount -> Amount -> Amount
|
||||
amt `at` priceamt = amt{aprice=Just $ UnitPrice $ Mixed [priceamt]}
|
||||
|
||||
-- | Set an amount's total price.
|
||||
(@@) :: Amount -> Amount -> Amount
|
||||
amt @@ priceamt = amt{aprice=Just $ TotalPrice $ Mixed [priceamt]}
|
||||
|
||||
tests_sumAmounts = [
|
||||
"sumAmounts" ~: do
|
||||
-- when adding, we don't convert to the price commodity - just
|
||||
-- combine what amounts we can.
|
||||
-- amounts with same unit price
|
||||
(sumAmounts [(Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 1]))])
|
||||
`is` (Mixed [Amount dollar 2 (Just $ UnitPrice $ Mixed [euros 1])])
|
||||
sumAmounts [usd 1 `at` eur 1, usd 1 `at` eur 1] `is` Mixed [usd 2 `at` eur 1]
|
||||
-- amounts with different unit prices
|
||||
-- amounts with total prices
|
||||
(sumAmounts [(Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]))])
|
||||
`is` (Mixed [(Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]))])
|
||||
sumAmounts [usd 1 @@ eur 1, usd 1 @@ eur 1] `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]
|
||||
-- amounts with no, unit, and/or total prices
|
||||
]
|
||||
|
||||
@ -152,20 +186,20 @@ tests_sumAmounts = [
|
||||
--
|
||||
-- - price amounts should be positive, though this is not currently enforced
|
||||
costOfAmount :: Amount -> Amount
|
||||
costOfAmount a@(Amount _ q price) =
|
||||
costOfAmount a@Amount{aquantity=q, aprice=price} =
|
||||
case price of
|
||||
Nothing -> a
|
||||
Just (UnitPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*q) Nothing
|
||||
Just (TotalPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*signum q) Nothing
|
||||
Just (UnitPrice (Mixed [p@Amount{aquantity=pq}])) -> p{aquantity=pq * q}
|
||||
Just (TotalPrice (Mixed [p@Amount{aquantity=pq}])) -> p{aquantity=pq * signum q}
|
||||
_ -> error' "costOfAmount: Malformed price encountered, programmer error"
|
||||
|
||||
-- | Divide an amount's quantity by a constant.
|
||||
divideAmount :: Amount -> Double -> Amount
|
||||
divideAmount a@Amount{quantity=q} d = a{quantity=q/d}
|
||||
divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d}
|
||||
|
||||
-- | Is this amount negative ? The price is ignored.
|
||||
isNegativeAmount :: Amount -> Bool
|
||||
isNegativeAmount Amount{quantity=q} = q < 0
|
||||
isNegativeAmount Amount{aquantity=q} = q < 0
|
||||
|
||||
digits = "123456789" :: String
|
||||
|
||||
@ -178,7 +212,7 @@ isZeroAmount a -- a==missingamt = False
|
||||
-- Since we are using floating point, for now just test to some high precision.
|
||||
isReallyZeroAmount :: Amount -> Bool
|
||||
isReallyZeroAmount a -- a==missingamt = False
|
||||
| otherwise = (null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") . quantity) a
|
||||
| otherwise = (null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") . aquantity) a
|
||||
where zeroprecision = 8
|
||||
|
||||
-- | Get the string representation of an amount, based on its commodity's
|
||||
@ -186,23 +220,27 @@ isReallyZeroAmount a -- a==missingamt = False
|
||||
showAmountWithPrecision :: Int -> Amount -> String
|
||||
showAmountWithPrecision p = showAmount . setAmountPrecision p
|
||||
|
||||
-- | Set the display precision in the amount's commodity.
|
||||
-- | Set an amount's display precision.
|
||||
setAmountPrecision :: Int -> Amount -> Amount
|
||||
setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}}
|
||||
setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}
|
||||
|
||||
-- | Set an amount's display precision, flipped.
|
||||
withPrecision :: Amount -> Int -> Amount
|
||||
withPrecision = flip setAmountPrecision
|
||||
|
||||
-- | Get the unambiguous string representation of an amount, for debugging.
|
||||
showAmountDebug :: Amount -> String
|
||||
showAmountDebug (Amount (Commodity {symbol="AUTO"}) _ _) = "(missing)"
|
||||
showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}"
|
||||
(show c) (show q) (maybe "Nothing" showPriceDebug pri)
|
||||
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
|
||||
showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}"
|
||||
(show acommodity) (show aquantity) (maybe "Nothing" showPriceDebug aprice) (show astyle)
|
||||
|
||||
-- | Get the string representation of an amount, without any \@ price.
|
||||
showAmountWithoutPrice :: Amount -> String
|
||||
showAmountWithoutPrice a = showAmount a{price=Nothing}
|
||||
showAmountWithoutPrice a = showAmount a{aprice=Nothing}
|
||||
|
||||
-- | Get the string representation of an amount, without any price or commodity symbol.
|
||||
showAmountWithoutPriceOrCommodity :: Amount -> String
|
||||
showAmountWithoutPriceOrCommodity a@Amount{commodity=c} = showAmount a{commodity=c{symbol=""}, price=Nothing}
|
||||
showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=Nothing}
|
||||
|
||||
showPrice :: Price -> String
|
||||
showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa
|
||||
@ -216,23 +254,23 @@ showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa
|
||||
-- display settings. String representations equivalent to zero are
|
||||
-- converted to just \"0\".
|
||||
showAmount :: Amount -> String
|
||||
showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = ""
|
||||
showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) =
|
||||
case side of
|
||||
L -> printf "%s%s%s%s" sym' space quantity' price
|
||||
R -> printf "%s%s%s%s" quantity' space sym' price
|
||||
showAmount Amount{acommodity="AUTO"} = ""
|
||||
showAmount a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) =
|
||||
case ascommodityside of
|
||||
L -> printf "%s%s%s%s" c' space quantity' price
|
||||
R -> printf "%s%s%s%s" quantity' space c' price
|
||||
where
|
||||
quantity = showamountquantity a
|
||||
displayingzero = null $ filter (`elem` digits) $ quantity
|
||||
(quantity',sym') | displayingzero = ("0","")
|
||||
| otherwise = (quantity,quoteCommoditySymbolIfNeeded sym)
|
||||
space = if (not (null sym') && spaced) then " " else "" :: String
|
||||
price = maybe "" showPrice pri
|
||||
(quantity',c') | displayingzero = ("0","")
|
||||
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
|
||||
space = if (not (null c') && ascommodityspaced) then " " else "" :: String
|
||||
price = maybe "" showPrice p
|
||||
|
||||
-- | Get the string representation of the number part of of an amount,
|
||||
-- using the display settings from its commodity.
|
||||
showamountquantity :: Amount -> String
|
||||
showamountquantity (Amount (Commodity {decimalpoint=d,precision=p,separator=s,separatorpositions=spos}) q _) =
|
||||
showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecimalpoint=d, asseparator=s, asseparatorpositions=spos}} =
|
||||
punctuatenumber d s spos $ qstr
|
||||
where
|
||||
-- isint n = fromIntegral (round n) == n
|
||||
@ -242,7 +280,8 @@ showamountquantity (Amount (Commodity {decimalpoint=d,precision=p,separator=s,se
|
||||
| otherwise = printf ("%."++show p++"f") q
|
||||
|
||||
-- | Replace a number string's decimal point with the specified character,
|
||||
-- and add the specified digit group separators.
|
||||
-- and add the specified digit group separators. The last digit group will
|
||||
-- be repeated as needed.
|
||||
punctuatenumber :: Char -> Char -> [Int] -> String -> String
|
||||
punctuatenumber dec sep grps str = sign ++ reverse (addseps sep (extend grps) (reverse int)) ++ frac''
|
||||
where
|
||||
@ -271,15 +310,12 @@ maxprecision = 999998
|
||||
maxprecisionwithpoint :: Int
|
||||
maxprecisionwithpoint = 999999
|
||||
|
||||
-- | Replace an amount's commodity with the canonicalised version from
|
||||
-- the provided commodity map.
|
||||
canonicaliseAmountCommodity :: Maybe (Map.Map String Commodity) -> Amount -> Amount
|
||||
canonicaliseAmountCommodity Nothing = id
|
||||
canonicaliseAmountCommodity (Just canonicalcommoditymap) = fixamount
|
||||
-- like journalCanonicaliseAmounts
|
||||
-- | Canonicalise an amount's display style using the provided commodity style map.
|
||||
canonicaliseAmount :: M.Map Commodity AmountStyle -> Amount -> Amount
|
||||
canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
|
||||
where
|
||||
-- like journalCanonicaliseAmounts
|
||||
fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c}
|
||||
fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap
|
||||
s' = findWithDefault s c styles
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- MixedAmount
|
||||
@ -287,7 +323,7 @@ canonicaliseAmountCommodity (Just canonicalcommoditymap) = fixamount
|
||||
instance Show MixedAmount where show = showMixedAmountDebug
|
||||
|
||||
instance Num MixedAmount where
|
||||
fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]
|
||||
fromInteger i = Mixed [fromInteger i]
|
||||
negate (Mixed as) = Mixed $ map negate as
|
||||
(+) (Mixed as) (Mixed bs) = normaliseMixedAmountPreservingPrices $ Mixed $ as ++ bs
|
||||
(*) = error' "programming error, mixed amounts do not support multiplication"
|
||||
@ -300,7 +336,7 @@ nullmixedamt = Mixed []
|
||||
|
||||
-- | A temporary value for parsed transactions which had no amount specified.
|
||||
missingamt :: Amount
|
||||
missingamt = Amount unknown{symbol="AUTO"} 0 Nothing
|
||||
missingamt = amount{acommodity="AUTO"}
|
||||
|
||||
missingmixedamt :: MixedAmount
|
||||
missingmixedamt = Mixed [missingamt]
|
||||
@ -312,30 +348,29 @@ normaliseMixedAmountPreservingPrices :: MixedAmount -> MixedAmount
|
||||
normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as''
|
||||
where
|
||||
as'' = if null nonzeros then [nullamt] else nonzeros
|
||||
(_,nonzeros) = partition isReallyZeroAmount $ filter (/= missingamt) as'
|
||||
as' = map sumAmountsUsingFirstPrice $ group $ sort as
|
||||
sort = sortBy (\a1 a2 -> compare (sym a1,price a1) (sym a2,price a2))
|
||||
sym = symbol . commodity
|
||||
group = groupBy (\a1 a2 -> sym a1 == sym a2 && sameunitprice a1 a2)
|
||||
(_,nonzeros) = partition isReallyZeroAmount as'
|
||||
as' = map sumAmountsUsingFirstPrice $ group $ sort $ filter (/= missingamt) as
|
||||
sort = sortBy (\a1 a2 -> compare (acommodity a1, aprice a1) (acommodity a2, aprice a2))
|
||||
group = groupBy (\a1 a2 -> acommodity a1 == acommodity a2 && sameunitprice a1 a2)
|
||||
where
|
||||
sameunitprice a1 a2 =
|
||||
case (price a1, price a2) of
|
||||
case (aprice a1, aprice a2) of
|
||||
(Nothing, Nothing) -> True
|
||||
(Just (UnitPrice p1), Just (UnitPrice p2)) -> p1 == p2
|
||||
_ -> False
|
||||
|
||||
tests_normaliseMixedAmountPreservingPrices = [
|
||||
"normaliseMixedAmountPreservingPrices" ~: do
|
||||
assertEqual "discard missing amount" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, missingamt])
|
||||
assertEqual "combine unpriced same-commodity amounts" (Mixed [dollars 2]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, dollars 2])
|
||||
assertEqual "discard missing amount" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [usd 0, missingamt])
|
||||
assertEqual "combine unpriced same-commodity amounts" (Mixed [usd 2]) (normaliseMixedAmountPreservingPrices $ Mixed [usd 0, usd 2])
|
||||
assertEqual "don't combine total-priced amounts"
|
||||
(Mixed
|
||||
[Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])
|
||||
,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
(normaliseMixedAmountPreservingPrices $ Mixed
|
||||
[Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])
|
||||
,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
|
||||
]
|
||||
@ -351,9 +386,8 @@ normaliseMixedAmountPreservingFirstPrice (Mixed as) = Mixed as''
|
||||
as'' = if null nonzeros then [nullamt] else nonzeros
|
||||
(_,nonzeros) = partition (\a -> isReallyZeroAmount a && a /= missingamt) as'
|
||||
as' = map sumAmountsUsingFirstPrice $ group $ sort as
|
||||
sort = sortBy (\a1 a2 -> compare (sym a1) (sym a2))
|
||||
group = groupBy (\a1 a2 -> sym a1 == sym a2)
|
||||
sym = symbol . commodity
|
||||
sort = sortBy (\a1 a2 -> compare (acommodity a1) (acommodity a2))
|
||||
group = groupBy (\a1 a2 -> acommodity a1 == acommodity a2)
|
||||
|
||||
-- discardPrice :: Amount -> Amount
|
||||
-- discardPrice a = a{price=Nothing}
|
||||
@ -362,7 +396,7 @@ normaliseMixedAmountPreservingFirstPrice (Mixed as) = Mixed as''
|
||||
-- discardPrices (Mixed as) = Mixed $ map discardPrice as
|
||||
|
||||
sumAmountsUsingFirstPrice [] = nullamt
|
||||
sumAmountsUsingFirstPrice as = (sum as){price=price $ head as}
|
||||
sumAmountsUsingFirstPrice as = (sum as){aprice=aprice $ head as}
|
||||
|
||||
-- | Get a mixed amount's component amounts.
|
||||
amounts :: MixedAmount -> [Amount]
|
||||
@ -396,12 +430,6 @@ isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmoun
|
||||
isReallyZeroMixedAmountCost :: MixedAmount -> Bool
|
||||
isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount
|
||||
|
||||
-- -- | Convert a mixed amount to the specified commodity, assuming an exchange rate of 1.
|
||||
mixedAmountWithCommodity :: Commodity -> MixedAmount -> Amount
|
||||
mixedAmountWithCommodity c (Mixed as) = Amount c total Nothing
|
||||
where
|
||||
total = sum $ map (quantity . amountWithCommodity c) as
|
||||
|
||||
-- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we
|
||||
-- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there.
|
||||
-- -- For now, use this when cross-commodity zero equality is important.
|
||||
@ -414,7 +442,7 @@ mixedAmountWithCommodity c (Mixed as) = Amount c total Nothing
|
||||
-- its component amounts. NB a mixed amount can have an empty amounts
|
||||
-- list in which case it shows as \"\".
|
||||
showMixedAmount :: MixedAmount -> String
|
||||
showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m
|
||||
showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m
|
||||
|
||||
-- | Compact labelled trace of a mixed amount.
|
||||
ltraceamount :: String -> MixedAmount -> MixedAmount
|
||||
@ -443,14 +471,30 @@ showMixedAmountWithoutPrice :: MixedAmount -> String
|
||||
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
|
||||
where
|
||||
(Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m
|
||||
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{price=Nothing}
|
||||
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}
|
||||
width = maximum $ map (length . showAmount) as
|
||||
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
|
||||
|
||||
-- | Replace a mixed amount's commodity with the canonicalised version from
|
||||
-- the provided commodity map.
|
||||
canonicaliseMixedAmountCommodity :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount
|
||||
canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map (canonicaliseAmountCommodity canonicalcommoditymap) as
|
||||
-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
|
||||
canonicaliseMixedAmount :: M.Map Commodity AmountStyle -> MixedAmount -> MixedAmount
|
||||
canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
|
||||
|
||||
-- | Given a list of amounts in parse order, build a map from commodities
|
||||
-- to canonical display styles for amounts in that commodity.
|
||||
canonicalStyles :: [Amount] -> M.Map Commodity AmountStyle
|
||||
canonicalStyles amts = M.fromList commstyles
|
||||
where
|
||||
samecomm = \a1 a2 -> acommodity a1 == acommodity a2
|
||||
commamts = [(acommodity $ head as, as) | as <- groupBy samecomm $ sortBy (comparing acommodity) amts]
|
||||
commstyles = [(c, s)
|
||||
| (c,as) <- commamts
|
||||
, let styles = map astyle as
|
||||
, let maxprec = maximum $ map asprecision styles
|
||||
, let s = (head styles){asprecision=maxprec}
|
||||
]
|
||||
|
||||
-- lookupStyle :: M.Map Commodity AmountStyle -> Commodity -> AmountStyle
|
||||
-- lookupStyle
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- misc
|
||||
@ -463,77 +507,78 @@ tests_Hledger_Data_Amount = TestList $
|
||||
-- Amount
|
||||
|
||||
"costOfAmount" ~: do
|
||||
costOfAmount (euros 1) `is` euros 1
|
||||
costOfAmount (euros 2){price=Just $ UnitPrice $ Mixed [dollars 2]} `is` dollars 4
|
||||
costOfAmount (euros 1){price=Just $ TotalPrice $ Mixed [dollars 2]} `is` dollars 2
|
||||
costOfAmount (euros (-1)){price=Just $ TotalPrice $ Mixed [dollars 2]} `is` dollars (-2)
|
||||
costOfAmount (eur 1) `is` eur 1
|
||||
costOfAmount (eur 2){aprice=Just $ UnitPrice $ Mixed [usd 2]} `is` usd 4
|
||||
costOfAmount (eur 1){aprice=Just $ TotalPrice $ Mixed [usd 2]} `is` usd 2
|
||||
costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ Mixed [usd 2]} `is` usd (-2)
|
||||
|
||||
,"isZeroAmount" ~: do
|
||||
assertBool "" $ isZeroAmount $ Amount unknown 0 Nothing
|
||||
assertBool "" $ isZeroAmount $ dollars 0
|
||||
assertBool "" $ isZeroAmount $ amount
|
||||
assertBool "" $ isZeroAmount $ usd 0
|
||||
|
||||
,"negating amounts" ~: do
|
||||
let a = dollars 1
|
||||
negate a `is` a{quantity=(-1)}
|
||||
let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}
|
||||
negate b `is` b{quantity=(-1)}
|
||||
let a = usd 1
|
||||
negate a `is` a{aquantity=(-1)}
|
||||
let b = (usd 1){aprice=Just $ UnitPrice $ Mixed [eur 2]}
|
||||
negate b `is` b{aquantity=(-1)}
|
||||
|
||||
,"adding amounts without prices" ~: do
|
||||
let a1 = dollars 1.23
|
||||
let a2 = dollars (-1.23)
|
||||
let a3 = dollars (-1.23)
|
||||
(a1 + a2) `is` Amount (comm "$") 0 Nothing
|
||||
(a1 + a3) `is` Amount (comm "$") 0 Nothing
|
||||
(a2 + a3) `is` Amount (comm "$") (-2.46) Nothing
|
||||
(a3 + a3) `is` Amount (comm "$") (-2.46) Nothing
|
||||
sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing
|
||||
let a1 = usd 1.23
|
||||
let a2 = usd (-1.23)
|
||||
let a3 = usd (-1.23)
|
||||
(a1 + a2) `is` usd 0
|
||||
(a1 + a3) `is` usd 0
|
||||
(a2 + a3) `is` usd (-2.46)
|
||||
(a3 + a3) `is` usd (-2.46)
|
||||
sum [a1,a2,a3,-a3] `is` usd 0
|
||||
-- highest precision is preserved
|
||||
let ap1 = (dollars 1){commodity=dollar{precision=1}}
|
||||
ap3 = (dollars 1){commodity=dollar{precision=3}}
|
||||
(sum [ap1,ap3]) `is` ap3{quantity=2}
|
||||
(sum [ap3,ap1]) `is` ap3{quantity=2}
|
||||
let ap1 = setAmountPrecision 1 $ usd 1
|
||||
ap3 = setAmountPrecision 3 $ usd 1
|
||||
(asprecision $ astyle $ sum [ap1,ap3]) `is` 3
|
||||
(asprecision $ astyle $ sum [ap3,ap1]) `is` 3
|
||||
-- adding different commodities assumes conversion rate 1
|
||||
assertBool "" $ isZeroAmount (a1 - euros 1.23)
|
||||
assertBool "" $ isZeroAmount (a1 - eur 1.23)
|
||||
|
||||
,"showAmount" ~: do
|
||||
showAmount (dollars 0 + pounds 0) `is` "0"
|
||||
showAmount (usd 0 + gbp 0) `is` "0"
|
||||
|
||||
-- MixedAmount
|
||||
|
||||
,"normaliseMixedAmountPreservingFirstPrice" ~: do
|
||||
normaliseMixedAmountPreservingFirstPrice (Mixed []) `is` Mixed [nullamt]
|
||||
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountPreservingFirstPrice (Mixed [Amount {commodity=dollar, quantity=10, price=Nothing}
|
||||
,Amount {commodity=dollar, quantity=10, price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))}
|
||||
,Amount {commodity=dollar, quantity=(-10), price=Nothing}
|
||||
,Amount {commodity=dollar, quantity=(-10), price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))}
|
||||
])
|
||||
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountPreservingFirstPrice
|
||||
(Mixed [usd 10
|
||||
,usd 10 @@ eur 7
|
||||
,usd (-10)
|
||||
,usd (-10) @@ eur 7
|
||||
])
|
||||
|
||||
,"adding mixed amounts" ~: do
|
||||
let dollar0 = dollar{precision=0}
|
||||
(sum $ map (Mixed . (\a -> [a]))
|
||||
[Amount dollar 1.25 Nothing,
|
||||
Amount dollar0 (-1) Nothing,
|
||||
Amount dollar (-0.25) Nothing])
|
||||
`is` Mixed [Amount unknown 0 Nothing]
|
||||
|
||||
[usd 1.25
|
||||
,setAmountPrecision 0 $ usd (-1)
|
||||
,usd (-0.25)
|
||||
])
|
||||
`is` Mixed [amount{aquantity=0}]
|
||||
|
||||
,"adding mixed amounts with total prices" ~: do
|
||||
(sum $ map (Mixed . (\a -> [a]))
|
||||
[Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])
|
||||
,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
`is` (Mixed [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])
|
||||
,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])
|
||||
`is` (Mixed [usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
|
||||
,"showMixedAmount" ~: do
|
||||
showMixedAmount (Mixed [dollars 1]) `is` "$1.00"
|
||||
showMixedAmount (Mixed [(dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}]) `is` "$1.00 @ €2.00"
|
||||
showMixedAmount (Mixed [dollars 0]) `is` "0"
|
||||
showMixedAmount (Mixed [usd 1]) `is` "$1.00"
|
||||
showMixedAmount (Mixed [usd 1 `at` eur 2]) `is` "$1.00 @ €2.00"
|
||||
showMixedAmount (Mixed [usd 0]) `is` "0"
|
||||
showMixedAmount (Mixed []) `is` "0"
|
||||
showMixedAmount missingmixedamt `is` ""
|
||||
|
||||
,"showMixedAmountWithoutPrice" ~: do
|
||||
let a = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}
|
||||
let a = usd 1 `at` eur 2
|
||||
showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00"
|
||||
showMixedAmountWithoutPrice (Mixed [a, (-a)]) `is` "0"
|
||||
|
||||
|
||||
@ -9,10 +9,9 @@ are thousands separated by comma, significant decimal places and so on.
|
||||
module Hledger.Data.Commodity
|
||||
where
|
||||
import Data.List
|
||||
import Data.Map ((!))
|
||||
import Data.Maybe
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Test.HUnit
|
||||
import qualified Data.Map as Map
|
||||
-- import qualified Data.Map as M
|
||||
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Utils
|
||||
@ -24,44 +23,47 @@ nonsimplecommoditychars = "0123456789-.@;\n \"{}" :: String
|
||||
quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\""
|
||||
| otherwise = s
|
||||
|
||||
-- convenient amount and commodity constructors, for tests etc.
|
||||
commodity = ""
|
||||
|
||||
unknown = Commodity {symbol="", side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]}
|
||||
dollar = Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=2,separator=',',separatorpositions=[]}
|
||||
euro = Commodity {symbol="€",side=L,spaced=False,decimalpoint='.',precision=2,separator=',',separatorpositions=[]}
|
||||
pound = Commodity {symbol="£",side=L,spaced=False,decimalpoint='.',precision=2,separator=',',separatorpositions=[]}
|
||||
hour = Commodity {symbol="h",side=R,spaced=False,decimalpoint='.',precision=1,separator=',',separatorpositions=[]}
|
||||
-- handy constructors for tests
|
||||
-- unknown = commodity
|
||||
-- usd = "$"
|
||||
-- eur = "€"
|
||||
-- gbp = "£"
|
||||
-- hour = "h"
|
||||
|
||||
dollars n = Amount dollar n Nothing
|
||||
euros n = Amount euro n Nothing
|
||||
pounds n = Amount pound n Nothing
|
||||
hours n = Amount hour n Nothing
|
||||
-- Some sample commodity' names and symbols, for use in tests..
|
||||
commoditysymbols =
|
||||
[("unknown","")
|
||||
,("usd","$")
|
||||
,("eur","€")
|
||||
,("gbp","£")
|
||||
,("hour","h")
|
||||
]
|
||||
|
||||
defaultcommodities = [dollar, euro, pound, hour, unknown]
|
||||
|
||||
-- | Look up one of the hard-coded default commodities. For use in tests.
|
||||
-- | Look up one of the sample commodities' symbol by name.
|
||||
comm :: String -> Commodity
|
||||
comm sym = fromMaybe
|
||||
comm name = snd $ fromMaybe
|
||||
(error' "commodity lookup failed")
|
||||
$ find (\(Commodity{symbol=s}) -> s==sym) defaultcommodities
|
||||
(find (\n -> fst n == name) commoditysymbols)
|
||||
|
||||
-- | Find the conversion rate between two commodities. Currently returns 1.
|
||||
conversionRate :: Commodity -> Commodity -> Double
|
||||
conversionRate _ _ = 1
|
||||
|
||||
-- | Convert a list of commodities to a map from commodity symbols to
|
||||
-- unique, display-preference-canonicalised commodities.
|
||||
canonicaliseCommodities :: [Commodity] -> Map.Map String Commodity
|
||||
canonicaliseCommodities cs =
|
||||
Map.fromList [(s,firstc{precision=maxp}) | s <- symbols,
|
||||
let cs = commoditymap ! s,
|
||||
let firstc = head cs,
|
||||
let maxp = maximum $ map precision cs
|
||||
]
|
||||
where
|
||||
commoditymap = Map.fromList [(s, commoditieswithsymbol s) | s <- symbols]
|
||||
commoditieswithsymbol s = filter ((s==) . symbol) cs
|
||||
symbols = nub $ map symbol cs
|
||||
-- -- | Convert a list of commodities to a map from commodity symbols to
|
||||
-- -- unique, display-preference-canonicalised commodities.
|
||||
-- canonicaliseCommodities :: [Commodity] -> Map.Map String Commodity
|
||||
-- canonicaliseCommodities cs =
|
||||
-- Map.fromList [(s,firstc{precision=maxp}) | s <- symbols,
|
||||
-- let cs = commoditymap ! s,
|
||||
-- let firstc = head cs,
|
||||
-- let maxp = maximum $ map precision cs
|
||||
-- ]
|
||||
-- where
|
||||
-- commoditymap = Map.fromList [(s, commoditieswithsymbol s) | s <- symbols]
|
||||
-- commoditieswithsymbol s = filter ((s==) . symbol) cs
|
||||
-- symbols = nub $ map symbol cs
|
||||
|
||||
tests_Hledger_Data_Commodity = TestList [
|
||||
]
|
||||
|
||||
@ -25,9 +25,9 @@ module Hledger.Data.Journal (
|
||||
-- * Querying
|
||||
journalAccountNames,
|
||||
journalAccountNamesUsed,
|
||||
journalAmountAndPriceCommodities,
|
||||
-- journalAmountAndPriceCommodities,
|
||||
journalAmounts,
|
||||
journalCanonicalCommodities,
|
||||
-- journalCanonicalCommodities,
|
||||
journalDateSpan,
|
||||
journalFilePath,
|
||||
journalFilePaths,
|
||||
@ -51,7 +51,7 @@ module Hledger.Data.Journal (
|
||||
)
|
||||
where
|
||||
import Data.List
|
||||
import Data.Map (findWithDefault)
|
||||
-- import Data.Map (findWithDefault)
|
||||
import Data.Ord
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
@ -60,13 +60,13 @@ import Safe (headDef)
|
||||
import System.Time (ClockTime(TOD))
|
||||
import Test.HUnit
|
||||
import Text.Printf
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.AccountName
|
||||
import Hledger.Data.Amount
|
||||
import Hledger.Data.Commodity
|
||||
-- import Hledger.Data.Commodity
|
||||
import Hledger.Data.Dates
|
||||
import Hledger.Data.Transaction
|
||||
import Hledger.Data.Posting
|
||||
@ -75,13 +75,14 @@ import Hledger.Query
|
||||
|
||||
|
||||
instance Show Journal where
|
||||
show j = printf "Journal %s with %d transactions, %d accounts: %s"
|
||||
show j = printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"
|
||||
(journalFilePath j)
|
||||
(length (jtxns j) +
|
||||
length (jmodifiertxns j) +
|
||||
length (jperiodictxns j))
|
||||
(length accounts)
|
||||
(show accounts)
|
||||
(show $ jcommoditystyles j)
|
||||
-- ++ (show $ journalTransactions l)
|
||||
where accounts = flatten $ journalAccountNameTree j
|
||||
|
||||
@ -107,10 +108,11 @@ nulljournal = Journal { jmodifiertxns = []
|
||||
, jContext = nullctx
|
||||
, files = []
|
||||
, filereadtime = TOD 0 0
|
||||
, jcommoditystyles = M.fromList []
|
||||
}
|
||||
|
||||
nullctx :: JournalContext
|
||||
nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [], ctxAliases = [] }
|
||||
nullctx = Ctx { ctxYear = Nothing, ctxCommodityAndStyle = Nothing, ctxAccount = [], ctxAliases = [] }
|
||||
|
||||
journalFilePath :: Journal -> FilePath
|
||||
journalFilePath = fst . mainfile
|
||||
@ -369,24 +371,28 @@ journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =
|
||||
-- amounts and working out the canonical commodities, since balancing
|
||||
-- depends on display precision. Reports only the first error encountered.
|
||||
journalBalanceTransactions :: Journal -> Either String Journal
|
||||
journalBalanceTransactions j@Journal{jtxns=ts} =
|
||||
journalBalanceTransactions j@Journal{jtxns=ts, jcommoditystyles=ss} =
|
||||
case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'}
|
||||
Left e -> Left e
|
||||
where balance = balanceTransaction (Just $ journalCanonicalCommodities j)
|
||||
where balance = balanceTransaction (Just ss)
|
||||
|
||||
-- | Convert all the journal's posting amounts (not price amounts) to
|
||||
-- their canonical display settings. Ie, all amounts in a given
|
||||
-- commodity will use (a) the display settings of the first, and (b)
|
||||
-- the greatest precision, of the posting amounts in that commodity.
|
||||
journalCanonicaliseAmounts :: Journal -> Journal
|
||||
journalCanonicaliseAmounts j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
|
||||
journalCanonicaliseAmounts j@Journal{jtxns=ts} = j''
|
||||
where
|
||||
j'' = j'{jtxns=map fixtransaction ts}
|
||||
j' = j{jcommoditystyles = canonicalStyles $ journalAmounts j}
|
||||
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
|
||||
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
|
||||
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
||||
fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c}
|
||||
fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap
|
||||
canonicalcommoditymap = journalCanonicalCommodities j
|
||||
fixamount a@Amount{acommodity=c} = a{astyle=journalCommodityStyle j' c}
|
||||
|
||||
-- | Get this journal's canonical amount style for the given commodity, or the null style.
|
||||
journalCommodityStyle :: Journal -> Commodity -> AmountStyle
|
||||
journalCommodityStyle j c = M.findWithDefault amountstyle c $ jcommoditystyles j
|
||||
|
||||
-- -- | Apply this journal's historical price records to unpriced amounts where possible.
|
||||
-- journalApplyHistoricalPrices :: Journal -> Journal
|
||||
@ -421,30 +427,34 @@ journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
|
||||
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
|
||||
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
|
||||
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
||||
fixamount = canonicaliseAmountCommodity (Just $ journalCanonicalCommodities j) . costOfAmount
|
||||
fixamount = canonicaliseAmount (jcommoditystyles j) . costOfAmount
|
||||
|
||||
-- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
|
||||
journalCanonicalCommodities :: Journal -> Map.Map String Commodity
|
||||
journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j
|
||||
-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
|
||||
-- journalCanonicalCommodities :: Journal -> M.Map String Commodity
|
||||
-- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j
|
||||
|
||||
-- | Get all this journal's amounts' commodities, in the order parsed.
|
||||
journalAmountCommodities :: Journal -> [Commodity]
|
||||
journalAmountCommodities = map commodity . concatMap amounts . journalAmounts
|
||||
-- -- | Get all this journal's amounts' commodities, in the order parsed.
|
||||
-- journalAmountCommodities :: Journal -> [Commodity]
|
||||
-- journalAmountCommodities = map acommodity . concatMap amounts . journalAmounts
|
||||
|
||||
-- | Get all this journal's amount and price commodities, in the order parsed.
|
||||
journalAmountAndPriceCommodities :: Journal -> [Commodity]
|
||||
journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts
|
||||
-- -- | Get all this journal's amount and price commodities, in the order parsed.
|
||||
-- journalAmountAndPriceCommodities :: Journal -> [Commodity]
|
||||
-- journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts
|
||||
|
||||
-- | Get this amount's commodity and any commodities referenced in its price.
|
||||
amountCommodities :: Amount -> [Commodity]
|
||||
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 this amount's commodity and any commodities referenced in its price.
|
||||
-- amountCommodities :: Amount -> [Commodity]
|
||||
-- amountCommodities Amount{acommodity=c,aprice=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]
|
||||
journalAmounts = map pamount . journalPostings
|
||||
-- | Get all this journal's (mixed) amounts, in the order parsed.
|
||||
journalMixedAmounts :: Journal -> [MixedAmount]
|
||||
journalMixedAmounts = map pamount . journalPostings
|
||||
|
||||
-- | Get all this journal's component amounts, roughly in the order parsed.
|
||||
journalAmounts :: Journal -> [Amount]
|
||||
journalAmounts = concatMap flatten . journalMixedAmounts where flatten (Mixed as) = as
|
||||
|
||||
-- | The (fully specified) date span containing this journal's transactions,
|
||||
-- or DateSpan Nothing Nothing if there are none.
|
||||
@ -475,8 +485,8 @@ isnegativepat = (negateprefix `isPrefixOf`)
|
||||
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
|
||||
|
||||
-- debug helpers
|
||||
-- traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a
|
||||
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps
|
||||
-- traceAmountPrecision a = trace (show $ map (precision . acommodity) $ amounts a) a
|
||||
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . acommodity) . amounts) . pamount) ps) ps
|
||||
|
||||
-- tests
|
||||
|
||||
@ -503,10 +513,9 @@ abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
|
||||
-- liabilities:debts $1
|
||||
-- assets:bank:checking
|
||||
--
|
||||
Right samplejournal = journalBalanceTransactions $ Journal
|
||||
[]
|
||||
[]
|
||||
[
|
||||
Right samplejournal = journalBalanceTransactions $
|
||||
nulljournal
|
||||
{jtxns = [
|
||||
txnTieKnot $ Transaction {
|
||||
tdate=parsedate "2008/01/01",
|
||||
teffectivedate=Nothing,
|
||||
@ -519,7 +528,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:bank:checking",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -550,7 +559,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:bank:checking",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -581,7 +590,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:bank:saving",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -590,7 +599,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:bank:checking",
|
||||
pamount=(Mixed [dollars (-1)]),
|
||||
pamount=(Mixed [usd (-1)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -612,7 +621,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="expenses:food",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -621,7 +630,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="expenses:supplies",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -652,7 +661,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="liabilities:debts",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -661,7 +670,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:bank:checking",
|
||||
pamount=(Mixed [dollars (-1)]),
|
||||
pamount=(Mixed [usd (-1)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -671,12 +680,7 @@ Right samplejournal = journalBalanceTransactions $ Journal
|
||||
tpreceding_comment_lines=""
|
||||
}
|
||||
]
|
||||
[]
|
||||
[]
|
||||
""
|
||||
nullctx
|
||||
[]
|
||||
(TOD 0 0)
|
||||
}
|
||||
|
||||
tests_Hledger_Data_Journal = TestList $
|
||||
[
|
||||
|
||||
@ -82,9 +82,9 @@ ledgerPostings = journalPostings . ljournal
|
||||
ledgerDateSpan :: Ledger -> DateSpan
|
||||
ledgerDateSpan = postingsDateSpan . ledgerPostings
|
||||
|
||||
-- | All commodities used in this ledger, as a map keyed by symbol.
|
||||
ledgerCommodities :: Ledger -> M.Map String Commodity
|
||||
ledgerCommodities = journalCanonicalCommodities . ljournal
|
||||
-- | All commodities used in this ledger.
|
||||
ledgerCommodities :: Ledger -> [Commodity]
|
||||
ledgerCommodities = M.keys . jcommoditystyles . ljournal
|
||||
|
||||
|
||||
tests_ledgerFromJournal = [
|
||||
|
||||
@ -20,7 +20,7 @@ import Text.Printf
|
||||
import Hledger.Utils
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.Dates
|
||||
import Hledger.Data.Commodity
|
||||
import Hledger.Data.Amount
|
||||
import Hledger.Data.Transaction
|
||||
|
||||
instance Show TimeLogEntry where
|
||||
@ -92,8 +92,8 @@ entryFromTimeLogInOut i o
|
||||
itod = localTimeOfDay itime
|
||||
otod = localTimeOfDay otime
|
||||
idate = localDay itime
|
||||
hrs = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
|
||||
amount = Mixed [hours hrs]
|
||||
hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
|
||||
amount = Mixed [hrs hours]
|
||||
ps = [Posting{pstatus=False,paccount=acctname,pamount=amount,
|
||||
pcomment="",ptype=VirtualPosting,ptags=[],ptransaction=Just t}]
|
||||
|
||||
|
||||
@ -47,7 +47,6 @@ import Hledger.Data.Types
|
||||
import Hledger.Data.Dates
|
||||
import Hledger.Data.Posting
|
||||
import Hledger.Data.Amount
|
||||
import Hledger.Data.Commodity
|
||||
|
||||
instance Show Transaction where show = showTransactionUnelided
|
||||
|
||||
@ -108,7 +107,7 @@ tests_showTransactionUnelided = [
|
||||
nullposting{
|
||||
pstatus=True,
|
||||
paccount="a",
|
||||
pamount=Mixed [dollars 1, hours 2],
|
||||
pamount=Mixed [usd 1, hrs 2],
|
||||
pcomment="pcomment1\npcomment2\n",
|
||||
ptype=RegularPosting,
|
||||
ptags=[("ptag1","val1"),("ptag2","val2")]
|
||||
@ -183,7 +182,7 @@ tests_postingAsLines = [
|
||||
nullposting{
|
||||
pstatus=True,
|
||||
paccount="a",
|
||||
pamount=Mixed [dollars 1, hours 2],
|
||||
pamount=Mixed [usd 1, hrs 2],
|
||||
pcomment="pcomment1\npcomment2\n",
|
||||
ptype=RegularPosting,
|
||||
ptags=[("ptag1","val1"),("ptag2","val2")]
|
||||
@ -236,14 +235,15 @@ transactionPostingBalances t = (sumPostings $ realPostings t
|
||||
-- | Is this transaction balanced ? A balanced transaction's real
|
||||
-- (non-virtual) postings sum to 0, and any balanced virtual postings
|
||||
-- also sum to 0.
|
||||
isTransactionBalanced :: Maybe (Map.Map String Commodity) -> Transaction -> Bool
|
||||
isTransactionBalanced canonicalcommoditymap t =
|
||||
isTransactionBalanced :: Maybe (Map.Map Commodity AmountStyle) -> Transaction -> Bool
|
||||
isTransactionBalanced styles t =
|
||||
-- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum
|
||||
isZeroMixedAmount rsum' && isZeroMixedAmount bvsum'
|
||||
where
|
||||
(rsum, _, bvsum) = transactionPostingBalances t
|
||||
rsum' = canonicaliseMixedAmountCommodity canonicalcommoditymap $ costOfMixedAmount rsum
|
||||
bvsum' = canonicaliseMixedAmountCommodity canonicalcommoditymap $ costOfMixedAmount bvsum
|
||||
rsum' = canonicalise $ costOfMixedAmount rsum
|
||||
bvsum' = canonicalise $ costOfMixedAmount bvsum
|
||||
canonicalise = maybe id canonicaliseMixedAmount styles
|
||||
|
||||
-- | Ensure this transaction is balanced, possibly inferring a missing
|
||||
-- amount or conversion price, or return an error message.
|
||||
@ -260,11 +260,11 @@ isTransactionBalanced canonicalcommoditymap t =
|
||||
-- and the sum of real postings' amounts is exactly two
|
||||
-- non-explicitly-priced amounts in different commodities (likewise
|
||||
-- for balanced virtual postings).
|
||||
balanceTransaction :: Maybe (Map.Map String Commodity) -> Transaction -> Either String Transaction
|
||||
balanceTransaction canonicalcommoditymap t@Transaction{tpostings=ps}
|
||||
balanceTransaction :: Maybe (Map.Map Commodity AmountStyle) -> Transaction -> Either String Transaction
|
||||
balanceTransaction styles t@Transaction{tpostings=ps}
|
||||
| length rwithoutamounts > 1 || length bvwithoutamounts > 1
|
||||
= Left $ printerr "could not balance this transaction (too many missing amounts)"
|
||||
| not $ isTransactionBalanced canonicalcommoditymap t''' = Left $ printerr $ nonzerobalanceerror t'''
|
||||
| not $ isTransactionBalanced styles t''' = Left $ printerr $ nonzerobalanceerror t'''
|
||||
| otherwise = Right t'''
|
||||
where
|
||||
-- maybe infer missing amounts
|
||||
@ -281,53 +281,53 @@ balanceTransaction canonicalcommoditymap t@Transaction{tpostings=ps}
|
||||
-- maybe infer conversion prices, for real postings
|
||||
rmixedamountsinorder = map pamount $ realPostings t'
|
||||
ramountsinorder = concatMap amounts rmixedamountsinorder
|
||||
rcommoditiesinorder = map commodity ramountsinorder
|
||||
rcommoditiesinorder = map acommodity ramountsinorder
|
||||
rsumamounts = amounts $ sum rmixedamountsinorder
|
||||
-- assumption: the sum of mixed amounts is normalised (one simple amount per commodity)
|
||||
t'' = if length rsumamounts == 2 && all (isNothing.price) rsumamounts && t'==t
|
||||
t'' = if length rsumamounts == 2 && all (isNothing.aprice) rsumamounts && t'==t
|
||||
then t'{tpostings=map inferprice ps}
|
||||
else t'
|
||||
where
|
||||
-- assumption: a posting's mixed amount contains one simple amount
|
||||
inferprice p@Posting{pamount=Mixed [a@Amount{commodity=c,price=Nothing}], ptype=RegularPosting}
|
||||
= p{pamount=Mixed [a{price=conversionprice c}]}
|
||||
inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=Nothing}], ptype=RegularPosting}
|
||||
= p{pamount=Mixed [a{aprice=conversionprice c}]}
|
||||
where
|
||||
conversionprice c | c == unpricedcommodity
|
||||
-- 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 Just $ TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
|
||||
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (quantity unpricedamount)]
|
||||
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
|
||||
| otherwise = Nothing
|
||||
where
|
||||
unpricedcommodity = head $ filter (`elem` (map commodity rsumamounts)) rcommoditiesinorder
|
||||
unpricedamount = head $ filter ((==unpricedcommodity).commodity) rsumamounts
|
||||
targetcommodityamount = head $ filter ((/=unpricedcommodity).commodity) rsumamounts
|
||||
ramountsinunpricedcommodity = filter ((==unpricedcommodity).commodity) ramountsinorder
|
||||
unpricedcommodity = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder
|
||||
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) rsumamounts
|
||||
targetcommodityamount = head $ filter ((/=unpricedcommodity).acommodity) rsumamounts
|
||||
ramountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) ramountsinorder
|
||||
inferprice p = p
|
||||
|
||||
-- maybe infer prices for balanced virtual postings. Just duplicates the above for now.
|
||||
bvmixedamountsinorder = map pamount $ balancedVirtualPostings t''
|
||||
bvamountsinorder = concatMap amounts bvmixedamountsinorder
|
||||
bvcommoditiesinorder = map commodity bvamountsinorder
|
||||
bvcommoditiesinorder = map acommodity bvamountsinorder
|
||||
bvsumamounts = amounts $ sum bvmixedamountsinorder
|
||||
t''' = if length bvsumamounts == 2 && all (isNothing.price) bvsumamounts && t'==t -- XXX could check specifically for bv amount inferring
|
||||
t''' = if length bvsumamounts == 2 && all (isNothing.aprice) bvsumamounts && t'==t -- XXX could check specifically for bv amount inferring
|
||||
then t''{tpostings=map inferprice ps}
|
||||
else t''
|
||||
where
|
||||
inferprice p@Posting{pamount=Mixed [a@Amount{commodity=c,price=Nothing}], ptype=BalancedVirtualPosting}
|
||||
= p{pamount=Mixed [a{price=conversionprice c}]}
|
||||
inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=Nothing}], ptype=BalancedVirtualPosting}
|
||||
= p{pamount=Mixed [a{aprice=conversionprice c}]}
|
||||
where
|
||||
conversionprice c | c == unpricedcommodity
|
||||
= if length bvamountsinunpricedcommodity == 1
|
||||
then Just $ TotalPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount]
|
||||
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (quantity unpricedamount)]
|
||||
else Just $ UnitPrice $ Mixed [setAmountPrecision maxprecision $ abs $ targetcommodityamount `divideAmount` (aquantity unpricedamount)]
|
||||
| otherwise = Nothing
|
||||
where
|
||||
unpricedcommodity = head $ filter (`elem` (map commodity bvsumamounts)) bvcommoditiesinorder
|
||||
unpricedamount = head $ filter ((==unpricedcommodity).commodity) bvsumamounts
|
||||
targetcommodityamount = head $ filter ((/=unpricedcommodity).commodity) bvsumamounts
|
||||
bvamountsinunpricedcommodity = filter ((==unpricedcommodity).commodity) bvamountsinorder
|
||||
unpricedcommodity = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder
|
||||
unpricedamount = head $ filter ((==unpricedcommodity).acommodity) bvsumamounts
|
||||
targetcommodityamount = head $ filter ((/=unpricedcommodity).acommodity) bvsumamounts
|
||||
bvamountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) bvamountsinorder
|
||||
inferprice p = p
|
||||
|
||||
printerr s = intercalate "\n" [s, showTransactionUnelided t]
|
||||
@ -376,8 +376,8 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
,""
|
||||
])
|
||||
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
|
||||
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] (Just t)
|
||||
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] (Just t)
|
||||
[Posting False "expenses:food:groceries" (Mixed [usd 47.18]) "" RegularPosting [] (Just t)
|
||||
,Posting False "assets:checking" (Mixed [usd (-47.18)]) "" RegularPosting [] (Just t)
|
||||
] ""
|
||||
in showTransaction t)
|
||||
|
||||
@ -390,8 +390,8 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
,""
|
||||
])
|
||||
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
|
||||
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] (Just t)
|
||||
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] (Just t)
|
||||
[Posting False "expenses:food:groceries" (Mixed [usd 47.18]) "" RegularPosting [] (Just t)
|
||||
,Posting False "assets:checking" (Mixed [usd (-47.18)]) "" RegularPosting [] (Just t)
|
||||
] ""
|
||||
in showTransactionUnelided t)
|
||||
|
||||
@ -406,8 +406,8 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
])
|
||||
(showTransaction
|
||||
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
|
||||
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing
|
||||
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting [] Nothing
|
||||
[Posting False "expenses:food:groceries" (Mixed [usd 47.18]) "" RegularPosting [] Nothing
|
||||
,Posting False "assets:checking" (Mixed [usd (-47.19)]) "" RegularPosting [] Nothing
|
||||
] ""))
|
||||
|
||||
,"showTransaction" ~: do
|
||||
@ -419,7 +419,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
])
|
||||
(showTransaction
|
||||
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
|
||||
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing
|
||||
[Posting False "expenses:food:groceries" (Mixed [usd 47.18]) "" RegularPosting [] Nothing
|
||||
] ""))
|
||||
|
||||
,"showTransaction" ~: do
|
||||
@ -444,7 +444,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
])
|
||||
(showTransaction
|
||||
(txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" []
|
||||
[Posting False "a" (Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting [] Nothing
|
||||
[Posting False "a" (Mixed [amt 1 `at` (setAmountPrecision 0 $ usd 2)]) "" RegularPosting [] Nothing
|
||||
,Posting False "b" missingmixedamt "" RegularPosting [] Nothing
|
||||
] ""))
|
||||
|
||||
@ -452,8 +452,8 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
assertBool "detect unbalanced entry, sign error"
|
||||
(isLeft $ balanceTransaction Nothing
|
||||
(Transaction (parsedate "2007/01/28") Nothing False "" "test" "" []
|
||||
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing,
|
||||
Posting False "b" (Mixed [dollars 1]) "" RegularPosting [] Nothing
|
||||
[Posting False "a" (Mixed [usd 1]) "" RegularPosting [] Nothing,
|
||||
Posting False "b" (Mixed [usd 1]) "" RegularPosting [] Nothing
|
||||
] ""))
|
||||
|
||||
assertBool "detect unbalanced entry, multiple missing amounts"
|
||||
@ -464,79 +464,75 @@ tests_Hledger_Data_Transaction = TestList $ concat [
|
||||
] ""))
|
||||
|
||||
let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "" "" []
|
||||
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing,
|
||||
[Posting False "a" (Mixed [usd 1]) "" RegularPosting [] Nothing,
|
||||
Posting False "b" missingmixedamt "" RegularPosting [] Nothing
|
||||
] "")
|
||||
assertBool "balanceTransaction allows one missing amount" (isRight e)
|
||||
assertEqual "balancing amount is inferred"
|
||||
(Mixed [dollars (-1)])
|
||||
(Mixed [usd (-1)])
|
||||
(case e of
|
||||
Right e' -> (pamount $ last $ tpostings e')
|
||||
Left _ -> error' "should not happen")
|
||||
|
||||
let e = balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" []
|
||||
[Posting False "a" (Mixed [dollars 1.35]) "" RegularPosting [] Nothing,
|
||||
Posting False "b" (Mixed [euros (-1)]) "" RegularPosting [] Nothing
|
||||
[Posting False "a" (Mixed [usd 1.35]) "" RegularPosting [] Nothing,
|
||||
Posting False "b" (Mixed [eur (-1)]) "" RegularPosting [] Nothing
|
||||
] "")
|
||||
assertBool "balanceTransaction can infer conversion price" (isRight e)
|
||||
assertEqual "balancing conversion price is inferred"
|
||||
(Mixed [Amount{commodity=dollar{precision=2},
|
||||
quantity=1.35,
|
||||
price=(Just $ TotalPrice $ Mixed [Amount{commodity=euro{precision=maxprecision},
|
||||
quantity=1,
|
||||
price=Nothing}])}])
|
||||
(Mixed [usd 1.35 @@ (setAmountPrecision maxprecision $ eur 1)])
|
||||
(case e of
|
||||
Right e' -> (pamount $ head $ tpostings e')
|
||||
Left _ -> error' "should not happen")
|
||||
|
||||
assertBool "balanceTransaction balances based on cost if there are unit prices" (isRight $
|
||||
balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" []
|
||||
[Posting False "a" (Mixed [Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 2])]) "" RegularPosting [] Nothing
|
||||
,Posting False "a" (Mixed [Amount dollar (-2) (Just $ UnitPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing
|
||||
[Posting False "a" (Mixed [usd 1 `at` eur 2]) "" RegularPosting [] Nothing
|
||||
,Posting False "a" (Mixed [usd (-2) `at` eur 1]) "" RegularPosting [] Nothing
|
||||
] ""))
|
||||
|
||||
assertBool "balanceTransaction balances based on cost if there are total prices" (isRight $
|
||||
balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" []
|
||||
[Posting False "a" (Mixed [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing
|
||||
,Posting False "a" (Mixed [Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing
|
||||
[Posting False "a" (Mixed [usd 1 @@ eur 1]) "" RegularPosting [] Nothing
|
||||
,Posting False "a" (Mixed [usd (-2) @@ eur 1]) "" RegularPosting [] Nothing
|
||||
] ""))
|
||||
|
||||
,"isTransactionBalanced" ~: do
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [usd (-1.00)]) "" RegularPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "detect balanced" (isTransactionBalanced Nothing t)
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [usd (-1.01)]) "" RegularPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "detect unbalanced" (not $ isTransactionBalanced Nothing t)
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 1.00]) "" RegularPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t)
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 0]) "" RegularPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "one zero posting is considered balanced for now" (isTransactionBalanced Nothing t)
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
|
||||
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [usd (-1.00)]) "" RegularPosting [] (Just t)
|
||||
,Posting False "d" (Mixed [usd 100]) "" VirtualPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "virtual postings don't need to balance" (isTransactionBalanced Nothing t)
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
|
||||
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [usd (-1.00)]) "" RegularPosting [] (Just t)
|
||||
,Posting False "d" (Mixed [usd 100]) "" BalancedVirtualPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced Nothing t)
|
||||
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
|
||||
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
|
||||
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t)
|
||||
,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting [] (Just t)
|
||||
[Posting False "b" (Mixed [usd 1.00]) "" RegularPosting [] (Just t)
|
||||
,Posting False "c" (Mixed [usd (-1.00)]) "" RegularPosting [] (Just t)
|
||||
,Posting False "d" (Mixed [usd 100]) "" BalancedVirtualPosting [] (Just t)
|
||||
,Posting False "e" (Mixed [usd (-100)]) "" BalancedVirtualPosting [] (Just t)
|
||||
] ""
|
||||
assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t)
|
||||
|
||||
|
||||
@ -20,6 +20,7 @@ For more detailed documentation on each type, see the corresponding modules.
|
||||
module Hledger.Data.Types
|
||||
where
|
||||
import Control.Monad.Error (ErrorT)
|
||||
import qualified Data.Map as M
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import Data.Typeable
|
||||
@ -42,31 +43,32 @@ type AccountName = String
|
||||
|
||||
data Side = L | R deriving (Eq,Show,Read,Ord)
|
||||
|
||||
data Commodity = Commodity {
|
||||
symbol :: String, -- ^ the commodity's symbol
|
||||
-- display preferences for amounts of this commodity
|
||||
side :: Side, -- ^ should the symbol appear on the left or the right
|
||||
spaced :: Bool, -- ^ should there be a space between symbol and quantity
|
||||
precision :: Int, -- ^ number of decimal places to display
|
||||
-- XXX these three might be better belonging to Journal
|
||||
decimalpoint :: Char, -- ^ character to use as decimal point
|
||||
separator :: Char, -- ^ character to use for separating digit groups (eg thousands)
|
||||
separatorpositions :: [Int] -- ^ positions of separators, counting leftward from decimal point
|
||||
} deriving (Eq,Ord,Show,Read)
|
||||
|
||||
type Commodity = String
|
||||
|
||||
type Quantity = Double
|
||||
|
||||
-- | An amount's price in another commodity may be written as \@ unit
|
||||
-- price or \@\@ total price. 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 = UnitPrice MixedAmount | TotalPrice MixedAmount
|
||||
data Price = {- NoPrice | -} UnitPrice MixedAmount | TotalPrice MixedAmount
|
||||
deriving (Eq,Ord)
|
||||
|
||||
-- | Display style for an amount.
|
||||
data AmountStyle = AmountStyle {
|
||||
ascommodityside :: Side, -- ^ does the symbol appear on the left or the right ?
|
||||
ascommodityspaced :: Bool, -- ^ space between symbol and quantity ?
|
||||
asprecision :: Int, -- ^ number of digits displayed after the decimal point
|
||||
asdecimalpoint :: Char, -- ^ character used as decimal point
|
||||
asseparator :: Char, -- ^ character used for separating digit groups (eg thousands)
|
||||
asseparatorpositions :: [Int] -- ^ positions of digit group separators, counting leftward from decimal point
|
||||
} deriving (Eq,Ord,Show,Read)
|
||||
|
||||
data Amount = Amount {
|
||||
commodity :: Commodity,
|
||||
quantity :: Quantity,
|
||||
price :: Maybe Price -- ^ the price for this amount at posting time
|
||||
acommodity :: Commodity,
|
||||
aquantity :: Quantity,
|
||||
aprice :: Maybe Price, -- ^ the price for this amount, fixed at posting time
|
||||
astyle :: AmountStyle
|
||||
} deriving (Eq,Ord)
|
||||
|
||||
newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord)
|
||||
@ -136,7 +138,7 @@ type Year = Integer
|
||||
-- is saved for later use by eg the add command.
|
||||
data JournalContext = Ctx {
|
||||
ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y
|
||||
, ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity most recently specified with D
|
||||
, ctxCommodityAndStyle :: !(Maybe (Commodity,AmountStyle)) -- ^ the default commodity and amount style most recently specified with D
|
||||
, ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components
|
||||
-- specified with "account" directive(s). Concatenated, these
|
||||
-- are the account prefix prepended to parsed account names.
|
||||
@ -155,7 +157,8 @@ data Journal = Journal {
|
||||
-- any included journal files. The main file is
|
||||
-- first followed by any included files in the
|
||||
-- order encountered (XXX reversed, cf journalAddFile).
|
||||
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s)
|
||||
filereadtime :: ClockTime, -- ^ when this journal was last read from its file(s)
|
||||
jcommoditystyles :: M.Map Commodity AmountStyle -- ^ how to display amounts in each commodity
|
||||
} deriving (Eq, Typeable)
|
||||
|
||||
-- | A JournalUpdate is some transformation of a Journal. It can do I/O or
|
||||
@ -239,6 +242,7 @@ data Account = Account {
|
||||
aname :: AccountName, -- ^ this account's full name
|
||||
aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts
|
||||
asubs :: [Account], -- ^ sub-accounts
|
||||
-- anumpostings :: Int -- ^ number of postings to this account
|
||||
-- derived from the above:
|
||||
aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts
|
||||
aparent :: Maybe Account, -- ^ parent account
|
||||
|
||||
@ -19,8 +19,8 @@ module Hledger.Read (
|
||||
ensureJournalFileExists,
|
||||
-- * Parsers used elsewhere
|
||||
accountname,
|
||||
amount,
|
||||
amount',
|
||||
amountp,
|
||||
amountp',
|
||||
-- * Tests
|
||||
samplejournal,
|
||||
tests_Hledger_Read,
|
||||
|
||||
@ -61,7 +61,7 @@ import Prelude hiding (getContents)
|
||||
import Hledger.Utils.UTF8IOCompat (getContents)
|
||||
import Hledger.Utils
|
||||
import Hledger.Data.FormatStrings as FormatStrings
|
||||
import Hledger.Read.JournalReader (accountname, amount)
|
||||
import Hledger.Read.JournalReader (accountname, amountp)
|
||||
|
||||
|
||||
reader :: Reader
|
||||
@ -426,7 +426,7 @@ transactionFromCsvRecord rules fields =
|
||||
strnegate s = '-':s
|
||||
currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)
|
||||
amountstr'' = currency ++ amountstr'
|
||||
amountparse = runParser amount nullctx "" amountstr''
|
||||
amountparse = runParser amountp nullctx "" amountstr''
|
||||
a = either (const nullmixedamt) id 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"
|
||||
|
||||
@ -27,8 +27,8 @@ module Hledger.Read.JournalReader (
|
||||
historicalpricedirective,
|
||||
datetime,
|
||||
accountname,
|
||||
amount,
|
||||
amount',
|
||||
amountp,
|
||||
amountp',
|
||||
emptyline,
|
||||
-- * Tests
|
||||
tests_Hledger_Read_JournalReader
|
||||
@ -102,11 +102,11 @@ setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
|
||||
getYear :: GenParser tok JournalContext (Maybe Integer)
|
||||
getYear = liftM ctxYear getState
|
||||
|
||||
setCommodity :: Commodity -> GenParser tok JournalContext ()
|
||||
setCommodity c = updateState (\ctx -> ctx{ctxCommodity=Just c})
|
||||
setCommodityAndStyle :: (Commodity,AmountStyle) -> GenParser tok JournalContext ()
|
||||
setCommodityAndStyle cs = updateState (\ctx -> ctx{ctxCommodityAndStyle=Just cs})
|
||||
|
||||
getCommodity :: GenParser tok JournalContext (Maybe Commodity)
|
||||
getCommodity = liftM ctxCommodity getState
|
||||
getCommodityAndStyle :: GenParser tok JournalContext (Maybe (Commodity,AmountStyle))
|
||||
getCommodityAndStyle = ctxCommodityAndStyle `fmap` getState
|
||||
|
||||
pushParentAccount :: String -> GenParser tok JournalContext ()
|
||||
pushParentAccount parent = updateState addParentAccount
|
||||
@ -254,10 +254,11 @@ defaultcommoditydirective :: GenParser Char JournalContext JournalUpdate
|
||||
defaultcommoditydirective = do
|
||||
char 'D' <?> "default commodity"
|
||||
many1 spacenonewline
|
||||
a <- amount
|
||||
a <- amountp
|
||||
-- amount always returns a MixedAmount containing one Amount, but let's be safe
|
||||
let as = amounts a
|
||||
when (not $ null as) $ setCommodity $ commodity $ head as
|
||||
let as = amounts a
|
||||
when (not $ null as) $
|
||||
let Amount{..} = head as in setCommodityAndStyle (acommodity, astyle)
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
@ -269,7 +270,7 @@ historicalpricedirective = do
|
||||
many1 spacenonewline
|
||||
symbol <- commoditysymbol
|
||||
many spacenonewline
|
||||
price <- amount
|
||||
price <- amountp
|
||||
restofline
|
||||
return $ HistoricalPrice date symbol price
|
||||
|
||||
@ -285,11 +286,11 @@ commodityconversiondirective :: GenParser Char JournalContext JournalUpdate
|
||||
commodityconversiondirective = do
|
||||
char 'C' <?> "commodity conversion"
|
||||
many1 spacenonewline
|
||||
amount
|
||||
amountp
|
||||
many spacenonewline
|
||||
char '='
|
||||
many spacenonewline
|
||||
amount
|
||||
amountp
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
@ -370,7 +371,7 @@ tests_transaction = [
|
||||
nullposting{
|
||||
pstatus=True,
|
||||
paccount="a",
|
||||
pamount=Mixed [dollars 1],
|
||||
pamount=Mixed [usd 1],
|
||||
pcomment="pcomment1\npcomment2\n",
|
||||
ptype=RegularPosting,
|
||||
ptags=[("ptag1","val1"),("ptag2","val2")],
|
||||
@ -514,7 +515,7 @@ tests_posting = [
|
||||
same ptransaction
|
||||
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
|
||||
`gives`
|
||||
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [("a","a a"), ("b","b b")] Nothing)
|
||||
(Posting False "expenses:food:dining" (Mixed [usd 10]) "" RegularPosting [("a","a a"), ("b","b b")] Nothing)
|
||||
|
||||
assertBool "posting parses a quoted commodity with numbers"
|
||||
(isRight $ parseWithCtx nullctx posting " a 1 \"DE123\"\n")
|
||||
@ -558,12 +559,12 @@ spaceandamountormissing :: GenParser Char JournalContext MixedAmount
|
||||
spaceandamountormissing =
|
||||
try (do
|
||||
many1 spacenonewline
|
||||
amount <|> return missingmixedamt
|
||||
amountp <|> return missingmixedamt
|
||||
) <|> return missingmixedamt
|
||||
|
||||
tests_spaceandamountormissing = [
|
||||
"spaceandamountormissing" ~: do
|
||||
assertParseEqual (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [dollars 47.18])
|
||||
assertParseEqual (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [usd 47.18])
|
||||
assertParseEqual (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt
|
||||
assertParseEqual (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt
|
||||
assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt
|
||||
@ -571,65 +572,58 @@ tests_spaceandamountormissing = [
|
||||
|
||||
-- | Parse an amount, optionally with a left or right currency symbol,
|
||||
-- price, and/or (ignored) ledger-style balance assertion.
|
||||
amount :: GenParser Char JournalContext MixedAmount
|
||||
amount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount
|
||||
amountp :: GenParser Char JournalContext MixedAmount
|
||||
amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount
|
||||
|
||||
tests_amount = [
|
||||
"amount" ~: do
|
||||
assertParseEqual (parseWithCtx nullctx amount "$47.18") (Mixed [dollars 47.18])
|
||||
assertParseEqual (parseWithCtx nullctx amount "$1.")
|
||||
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} 1 Nothing])
|
||||
tests_amountp = [
|
||||
"amountp" ~: do
|
||||
assertParseEqual (parseWithCtx nullctx amountp "$47.18") (Mixed [usd 47.18])
|
||||
assertParseEqual (parseWithCtx nullctx amountp "$1.") (Mixed [setAmountPrecision 0 $ usd 1])
|
||||
,"amount with unit price" ~: do
|
||||
assertParseEqual
|
||||
(parseWithCtx nullctx amount "$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}])}])
|
||||
(parseWithCtx nullctx amountp "$10 @ €0.5")
|
||||
(Mixed [usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)])
|
||||
,"amount with total price" ~: do
|
||||
assertParseEqual
|
||||
(parseWithCtx nullctx amount "$10 @@ €5")
|
||||
(Mixed [Amount{commodity=dollar{precision=0},
|
||||
quantity=10,
|
||||
price=(Just $ TotalPrice $ Mixed [Amount{commodity=euro{precision=0},
|
||||
quantity=5,
|
||||
price=Nothing}])}])
|
||||
(parseWithCtx nullctx amountp "$10 @@ €5")
|
||||
(Mixed [usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)])
|
||||
]
|
||||
|
||||
-- | Run the amount parser on a string to get the result or an error.
|
||||
amount' :: String -> MixedAmount
|
||||
amount' s = either (error' . show) id $ parseWithCtx nullctx amount s
|
||||
amountp' :: String -> MixedAmount
|
||||
amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s
|
||||
|
||||
leftsymbolamount :: GenParser Char JournalContext MixedAmount
|
||||
leftsymbolamount = do
|
||||
sign <- optionMaybe $ string "-"
|
||||
let applysign = if isJust sign then negate else id
|
||||
sym <- commoditysymbol
|
||||
c <- commoditysymbol
|
||||
sp <- many spacenonewline
|
||||
(q,p,d,s,spos) <- number
|
||||
pri <- priceamount
|
||||
let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,decimalpoint=d,precision=p,separator=s,separatorpositions=spos}
|
||||
return $ applysign $ Mixed [Amount c q pri]
|
||||
(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]
|
||||
<?> "left-symbol amount"
|
||||
|
||||
rightsymbolamount :: GenParser Char JournalContext MixedAmount
|
||||
rightsymbolamount = do
|
||||
(q,p,d,s,spos) <- number
|
||||
(q,prec,dec,sep,seppos) <- number
|
||||
sp <- many spacenonewline
|
||||
sym <- commoditysymbol
|
||||
pri <- priceamount
|
||||
let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,decimalpoint=d,precision=p,separator=s,separatorpositions=spos}
|
||||
return $ Mixed [Amount c q pri]
|
||||
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]
|
||||
<?> "right-symbol amount"
|
||||
|
||||
nosymbolamount :: GenParser Char JournalContext MixedAmount
|
||||
nosymbolamount = do
|
||||
(q,p,d,s,spos) <- number
|
||||
pri <- priceamount
|
||||
defc <- getCommodity
|
||||
let c = fromMaybe Commodity{symbol="",side=L,spaced=False,decimalpoint=d,precision=p,separator=s,separatorpositions=spos} defc
|
||||
return $ Mixed [Amount c q pri]
|
||||
(q,prec,dec,sep,seppos) <- number
|
||||
p <- priceamount
|
||||
defcs <- getCommodityAndStyle
|
||||
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]
|
||||
<?> "no-symbol amount"
|
||||
|
||||
commoditysymbol :: GenParser Char JournalContext String
|
||||
@ -653,11 +647,11 @@ priceamount =
|
||||
try (do
|
||||
char '@'
|
||||
many spacenonewline
|
||||
a <- amount -- XXX can parse more prices ad infinitum, shouldn't
|
||||
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
||||
return $ Just $ TotalPrice a)
|
||||
<|> (do
|
||||
many spacenonewline
|
||||
a <- amount -- XXX can parse more prices ad infinitum, shouldn't
|
||||
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
|
||||
return $ Just $ UnitPrice a))
|
||||
<|> return Nothing
|
||||
|
||||
@ -667,7 +661,7 @@ balanceassertion =
|
||||
many spacenonewline
|
||||
char '='
|
||||
many spacenonewline
|
||||
a <- amount -- XXX should restrict to a simple amount
|
||||
a <- amountp -- XXX should restrict to a simple amount
|
||||
return $ Just a)
|
||||
<|> return Nothing
|
||||
|
||||
@ -680,7 +674,7 @@ fixedlotprice =
|
||||
many spacenonewline
|
||||
char '='
|
||||
many spacenonewline
|
||||
a <- amount -- XXX should restrict to a simple amount
|
||||
a <- amountp -- XXX should restrict to a simple amount
|
||||
many spacenonewline
|
||||
char '}'
|
||||
return $ Just a)
|
||||
@ -841,7 +835,7 @@ tests_tagcomment = [
|
||||
|
||||
tests_Hledger_Read_JournalReader = TestList $ concat [
|
||||
tests_number,
|
||||
tests_amount,
|
||||
tests_amountp,
|
||||
tests_spaceandamountormissing,
|
||||
tests_tagcomment,
|
||||
tests_inlinecomment,
|
||||
@ -891,7 +885,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 [dollars 55])
|
||||
assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [usd 55])
|
||||
|
||||
,"ignoredpricecommoditydirective" ~: do
|
||||
assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n")
|
||||
@ -916,19 +910,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 [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} 1 Nothing])
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1")
|
||||
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} (-1) Nothing])
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1")
|
||||
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} (-1) Nothing])
|
||||
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])
|
||||
|
||||
,"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 amount "1 @ $2")
|
||||
(Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])])
|
||||
assertMixedAmountParse (parseWithCtx nullctx amountp "1 @ $2")
|
||||
(Mixed [amt 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)])
|
||||
|
||||
]]
|
||||
|
||||
@ -941,6 +932,6 @@ entry1_str = unlines
|
||||
|
||||
entry1 =
|
||||
txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
|
||||
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing,
|
||||
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] Nothing] ""
|
||||
[Posting False "expenses:food:groceries" (Mixed [usd 47.18]) "" RegularPosting [] Nothing,
|
||||
Posting False "assets:checking" (Mixed [usd (-47.18)]) "" RegularPosting [] Nothing] ""
|
||||
|
||||
|
||||
@ -56,13 +56,12 @@ import Data.Time.Calendar
|
||||
-- import Data.Tree
|
||||
import Safe (headMay, lastMay)
|
||||
import System.Console.CmdArgs -- for defaults support
|
||||
import System.Time (ClockTime(TOD))
|
||||
import Test.HUnit
|
||||
import Text.ParserCombinators.Parsec
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Read (amount')
|
||||
import Hledger.Read (amountp')
|
||||
import Hledger.Query
|
||||
import Hledger.Utils
|
||||
|
||||
@ -425,7 +424,7 @@ type TransactionsReportItem = (Transaction -- the corresponding transaction
|
||||
|
||||
triDate (t,_,_,_,_,_) = tdate t
|
||||
triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
|
||||
(Amount{quantity=q}):_ -> show q
|
||||
(Amount{aquantity=q}):_ -> show q
|
||||
|
||||
-- | Select transactions from the whole journal for a transactions report,
|
||||
-- with no \"current\" account. The end result is similar to
|
||||
@ -760,36 +759,36 @@ tests_accountsReport =
|
||||
,"accountsReport with no args on sample journal" ~: do
|
||||
(defreportopts, samplejournal) `gives`
|
||||
([
|
||||
("assets","assets",0, amount' "$-1.00")
|
||||
,("assets:bank:saving","bank:saving",1, amount' "$1.00")
|
||||
,("assets:cash","cash",1, amount' "$-2.00")
|
||||
,("expenses","expenses",0, amount' "$2.00")
|
||||
,("expenses:food","food",1, amount' "$1.00")
|
||||
,("expenses:supplies","supplies",1, amount' "$1.00")
|
||||
,("income","income",0, amount' "$-2.00")
|
||||
,("income:gifts","gifts",1, amount' "$-1.00")
|
||||
,("income:salary","salary",1, amount' "$-1.00")
|
||||
,("liabilities:debts","liabilities:debts",0, amount' "$1.00")
|
||||
("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")
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
,"accountsReport with --depth=N" ~: do
|
||||
(defreportopts{depth_=Just 1}, samplejournal) `gives`
|
||||
([
|
||||
("assets", "assets", 0, amount' "$-1.00")
|
||||
,("expenses", "expenses", 0, amount' "$2.00")
|
||||
,("income", "income", 0, amount' "$-2.00")
|
||||
,("liabilities", "liabilities", 0, amount' "$1.00")
|
||||
("assets", "assets", 0, amountp' "$-1.00")
|
||||
,("expenses", "expenses", 0, amountp' "$2.00")
|
||||
,("income", "income", 0, amountp' "$-2.00")
|
||||
,("liabilities", "liabilities", 0, amountp' "$1.00")
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
,"accountsReport with depth:N" ~: do
|
||||
(defreportopts{query_="depth:1"}, samplejournal) `gives`
|
||||
([
|
||||
("assets", "assets", 0, amount' "$-1.00")
|
||||
,("expenses", "expenses", 0, amount' "$2.00")
|
||||
,("income", "income", 0, amount' "$-2.00")
|
||||
,("liabilities", "liabilities", 0, amount' "$1.00")
|
||||
("assets", "assets", 0, amountp' "$-1.00")
|
||||
,("expenses", "expenses", 0, amountp' "$2.00")
|
||||
,("income", "income", 0, amountp' "$-2.00")
|
||||
,("liabilities", "liabilities", 0, amountp' "$1.00")
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
@ -799,32 +798,32 @@ tests_accountsReport =
|
||||
Mixed [nullamt])
|
||||
(defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,amount' "$1.00")
|
||||
,("income:salary","income:salary",0,amount' "$-1.00")
|
||||
("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00")
|
||||
,("income:salary","income:salary",0,amountp' "$-1.00")
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
,"accountsReport with desc:" ~: do
|
||||
(defreportopts{query_="desc:income"}, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,amount' "$1.00")
|
||||
,("income:salary","income:salary",0, amount' "$-1.00")
|
||||
("assets:bank:checking","assets:bank:checking",0,amountp' "$1.00")
|
||||
,("income:salary","income:salary",0, amountp' "$-1.00")
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
,"accountsReport with not:desc:" ~: do
|
||||
(defreportopts{query_="not:desc:income"}, samplejournal) `gives`
|
||||
([
|
||||
("assets","assets",0, amount' "$-2.00")
|
||||
("assets","assets",0, amountp' "$-2.00")
|
||||
,("assets:bank","bank",1, Mixed [nullamt])
|
||||
,("assets:bank:checking","checking",2,amount' "$-1.00")
|
||||
,("assets:bank:saving","saving",2, amount' "$1.00")
|
||||
,("assets:cash","cash",1, amount' "$-2.00")
|
||||
,("expenses","expenses",0, amount' "$2.00")
|
||||
,("expenses:food","food",1, amount' "$1.00")
|
||||
,("expenses:supplies","supplies",1, amount' "$1.00")
|
||||
,("income:gifts","income:gifts",0, amount' "$-1.00")
|
||||
,("liabilities:debts","liabilities:debts",0, amount' "$1.00")
|
||||
,("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")
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
@ -945,10 +944,9 @@ tests_accountsReport =
|
||||
-}
|
||||
]
|
||||
|
||||
Right samplejournal2 = journalBalanceTransactions $ Journal
|
||||
[]
|
||||
[]
|
||||
[
|
||||
Right samplejournal2 = journalBalanceTransactions $
|
||||
nulljournal
|
||||
{jtxns = [
|
||||
txnTieKnot $ Transaction {
|
||||
tdate=parsedate "2008/01/01",
|
||||
teffectivedate=Just $ parsedate "2009/01/01",
|
||||
@ -961,7 +959,7 @@ Right samplejournal2 = journalBalanceTransactions $ Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:bank:checking",
|
||||
pamount=(Mixed [dollars 1]),
|
||||
pamount=(Mixed [usd 1]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -980,13 +978,8 @@ Right samplejournal2 = journalBalanceTransactions $ Journal
|
||||
tpreceding_comment_lines=""
|
||||
}
|
||||
]
|
||||
[]
|
||||
[]
|
||||
""
|
||||
nullctx
|
||||
[]
|
||||
(TOD 0 0)
|
||||
|
||||
}
|
||||
|
||||
-- tests_isInterestingIndented = [
|
||||
-- "isInterestingIndented" ~: do
|
||||
-- let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
|
||||
@ -1010,10 +1003,10 @@ tests_Hledger_Reports = TestList $
|
||||
-- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)
|
||||
-- let ps =
|
||||
-- [
|
||||
-- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
|
||||
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]}
|
||||
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
|
||||
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 8]}
|
||||
-- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}
|
||||
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 2]}
|
||||
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [usd 4]}
|
||||
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 8]}
|
||||
-- ]
|
||||
-- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`
|
||||
-- []
|
||||
@ -1023,21 +1016,21 @@ tests_Hledger_Reports = TestList $
|
||||
-- ]
|
||||
-- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
|
||||
-- [
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
|
||||
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 10]}
|
||||
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]}
|
||||
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]}
|
||||
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}
|
||||
-- ]
|
||||
-- ("2008/01/01","2009/01/01",0,2,False,ts) `gives`
|
||||
-- [
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]}
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]}
|
||||
-- ]
|
||||
-- ("2008/01/01","2009/01/01",0,1,False,ts) `gives`
|
||||
-- [
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]}
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]}
|
||||
-- ]
|
||||
-- ("2008/01/01","2009/01/01",0,0,False,ts) `gives`
|
||||
-- [
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}
|
||||
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]}
|
||||
-- ]
|
||||
|
||||
]
|
||||
|
||||
@ -23,9 +23,7 @@ module Hledger.Cli (
|
||||
tests_Hledger_Cli
|
||||
)
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
import Data.Time.Calendar
|
||||
import System.Time (ClockTime(TOD))
|
||||
import Test.HUnit
|
||||
|
||||
import Hledger
|
||||
@ -110,12 +108,9 @@ tests_Hledger_Cli = TestList
|
||||
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
|
||||
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
|
||||
|
||||
,"journalCanonicaliseAmounts" ~:
|
||||
"use the greatest precision" ~:
|
||||
(map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
|
||||
|
||||
,"commodities" ~:
|
||||
Map.elems (ledgerCommodities ledger7) `is` [Commodity {symbol="$", side=L, spaced=False, decimalpoint='.', precision=2, separator=',', separatorpositions=[]}]
|
||||
-- ,"journalCanonicaliseAmounts" ~:
|
||||
-- "use the greatest precision" ~:
|
||||
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
|
||||
|
||||
-- don't know what this should do
|
||||
-- ,"elideAccountName" ~: do
|
||||
@ -129,9 +124,9 @@ tests_Hledger_Cli = TestList
|
||||
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
|
||||
return ()
|
||||
|
||||
,"show dollars" ~: showAmount (dollars 1) ~?= "$1.00"
|
||||
,"show dollars" ~: showAmount (usd 1) ~?= "$1.00"
|
||||
|
||||
,"show hours" ~: showAmount (hours 1) ~?= "1.0h"
|
||||
,"show hours" ~: showAmount (hrs 1) ~?= "1.0h"
|
||||
|
||||
]
|
||||
|
||||
@ -337,9 +332,7 @@ defaultyear_journal_str = unlines
|
||||
-- ,""
|
||||
-- ]
|
||||
|
||||
journal7 = Journal
|
||||
[]
|
||||
[]
|
||||
journal7 = nulljournal {jtxns =
|
||||
[
|
||||
txnTieKnot $ Transaction {
|
||||
tdate=parsedate "2007/01/01",
|
||||
@ -353,7 +346,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:cash",
|
||||
pamount=(Mixed [dollars 4.82]),
|
||||
pamount=(Mixed [usd 4.82]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -362,7 +355,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="equity:opening balances",
|
||||
pamount=(Mixed [dollars (-4.82)]),
|
||||
pamount=(Mixed [usd (-4.82)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -384,7 +377,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="expenses:vacation",
|
||||
pamount=(Mixed [dollars 179.92]),
|
||||
pamount=(Mixed [usd 179.92]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -393,7 +386,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:checking",
|
||||
pamount=(Mixed [dollars (-179.92)]),
|
||||
pamount=(Mixed [usd (-179.92)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -415,7 +408,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:saving",
|
||||
pamount=(Mixed [dollars 200]),
|
||||
pamount=(Mixed [usd 200]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -424,7 +417,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:checking",
|
||||
pamount=(Mixed [dollars (-200)]),
|
||||
pamount=(Mixed [usd (-200)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -446,7 +439,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="expenses:food:dining",
|
||||
pamount=(Mixed [dollars 4.82]),
|
||||
pamount=(Mixed [usd 4.82]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -455,7 +448,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:cash",
|
||||
pamount=(Mixed [dollars (-4.82)]),
|
||||
pamount=(Mixed [usd (-4.82)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -477,7 +470,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="expenses:phone",
|
||||
pamount=(Mixed [dollars 95.11]),
|
||||
pamount=(Mixed [usd 95.11]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -486,7 +479,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:checking",
|
||||
pamount=(Mixed [dollars (-95.11)]),
|
||||
pamount=(Mixed [usd (-95.11)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -508,7 +501,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="liabilities:credit cards:discover",
|
||||
pamount=(Mixed [dollars 80]),
|
||||
pamount=(Mixed [usd 80]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -517,7 +510,7 @@ journal7 = Journal
|
||||
Posting {
|
||||
pstatus=False,
|
||||
paccount="assets:checking",
|
||||
pamount=(Mixed [dollars (-80)]),
|
||||
pamount=(Mixed [usd (-80)]),
|
||||
pcomment="",
|
||||
ptype=RegularPosting,
|
||||
ptags=[],
|
||||
@ -527,12 +520,7 @@ journal7 = Journal
|
||||
tpreceding_comment_lines=""
|
||||
}
|
||||
]
|
||||
[]
|
||||
[]
|
||||
""
|
||||
nullctx
|
||||
[]
|
||||
(TOD 0 0)
|
||||
}
|
||||
|
||||
ledger7 = ledgerFromJournal Any journal7
|
||||
|
||||
@ -549,20 +537,13 @@ ledger7 = ledgerFromJournal Any journal7
|
||||
-- timelogentry2_str = "o 2007/03/11 16:30:00\n"
|
||||
-- timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") ""
|
||||
|
||||
-- a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}]
|
||||
-- a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]
|
||||
-- a1 = Mixed [(hrs 1){aprice=Just $ Mixed [Amount (comm "$") 10 Nothing]}]
|
||||
-- a2 = Mixed [(hrs 2){aprice=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]
|
||||
-- a3 = Mixed $ amounts a1 ++ amounts a2
|
||||
|
||||
journalWithAmounts :: [String] -> Journal
|
||||
journalWithAmounts as =
|
||||
Journal
|
||||
[]
|
||||
[]
|
||||
[t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}]
|
||||
[]
|
||||
[]
|
||||
""
|
||||
nullctx
|
||||
[]
|
||||
(TOD 0 0)
|
||||
where parse = fromparse . parseWithCtx nullctx amount
|
||||
-- journalWithAmounts :: [String] -> Journal
|
||||
-- journalWithAmounts as =
|
||||
-- nulljournal{jtxns=
|
||||
-- [t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}]
|
||||
-- }
|
||||
-- where parse = fromparse . parseWithCtx nullctx amountp
|
||||
|
||||
@ -148,14 +148,14 @@ 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 (amount <|> return missingmixedamt) ctx "" amountstr
|
||||
a' = fromparse $ runParser (amount <|> return missingmixedamt) nullctx "" amountstr
|
||||
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 . commodity) . headMay . amounts
|
||||
maybemixedamountcommodity = maybe Nothing (Just . acommodity) . headMay . amounts
|
||||
p = nullposting{paccount=stripbrackets account,
|
||||
pamount=a,
|
||||
ptype=postingtype account}
|
||||
@ -163,7 +163,7 @@ getPostings st enteredps = do
|
||||
else st{psHistory = historicalps',
|
||||
psSuggestHistoricalAmount = False}
|
||||
when (isJust commodityadded) $
|
||||
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (symbol $ fromJust commodityadded)
|
||||
liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust commodityadded)
|
||||
getPostings st' (enteredps ++ [p])
|
||||
where
|
||||
j = psJournal st
|
||||
@ -179,7 +179,7 @@ getPostings st enteredps = do
|
||||
postingtype _ = RegularPosting
|
||||
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse
|
||||
validateamount = Just $ \s -> (null s && not (null enteredrealps))
|
||||
|| isRight (runParser (amount>>many spacenonewline>>eof) ctx "" s)
|
||||
|| isRight (runParser (amountp >> many spacenonewline >> eof) ctx "" s)
|
||||
|
||||
-- | Prompt for and read a string value, optionally with a default value
|
||||
-- and a validator. A validator causes the prompt to repeat until the
|
||||
|
||||
@ -62,7 +62,7 @@ showLedgerStats l today span =
|
||||
path = journalFilePath j
|
||||
ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns j
|
||||
as = nub $ map paccount $ concatMap tpostings ts
|
||||
cs = Map.keys $ canonicaliseCommodities $ nub $ map commodity $ concatMap amounts $ map pamount $ concatMap tpostings ts
|
||||
cs = Map.keys $ canonicalStyles $ concatMap amounts $ map pamount $ concatMap tpostings ts
|
||||
lastdate | null ts = Nothing
|
||||
| otherwise = Just $ tdate $ last ts
|
||||
lastelapsed = maybe Nothing (Just . diffDays today) lastdate
|
||||
|
||||
Loading…
Reference in New Issue
Block a user