hledger-lib 0.19.1 → 0.19.3
raw patch · 13 files changed
+530/−480 lines, 13 filesdep −shakespeare-textPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: shakespeare-text
API changes (from Hackage documentation)
- Hledger.Data.Amount: canonicaliseAmountCommodity :: Maybe (Map String Commodity) -> Amount -> Amount
- Hledger.Data.Amount: canonicaliseMixedAmountCommodity :: Maybe (Map String Commodity) -> MixedAmount -> MixedAmount
- Hledger.Data.Amount: mixedAmountWithCommodity :: Commodity -> MixedAmount -> Amount
- Hledger.Data.Commodity: canonicaliseCommodities :: [Commodity] -> Map String Commodity
- Hledger.Data.Commodity: defaultcommodities :: [Commodity]
- Hledger.Data.Commodity: dollar :: Commodity
- Hledger.Data.Commodity: dollars :: Quantity -> Amount
- Hledger.Data.Commodity: euro :: Commodity
- Hledger.Data.Commodity: euros :: Quantity -> Amount
- Hledger.Data.Commodity: hour :: Commodity
- Hledger.Data.Commodity: hours :: Quantity -> Amount
- Hledger.Data.Commodity: pound :: Commodity
- Hledger.Data.Commodity: pounds :: Quantity -> Amount
- Hledger.Data.Commodity: unknown :: Commodity
- Hledger.Data.Journal: journalAmountAndPriceCommodities :: Journal -> [Commodity]
- Hledger.Data.Journal: journalCanonicalCommodities :: Journal -> Map String Commodity
- Hledger.Data.Types: Commodity :: String -> Side -> Bool -> Int -> Char -> Char -> [Int] -> Commodity
- Hledger.Data.Types: commodity :: Amount -> Commodity
- Hledger.Data.Types: ctxCommodity :: JournalContext -> !(Maybe Commodity)
- Hledger.Data.Types: data Commodity
- Hledger.Data.Types: decimalpoint :: Commodity -> Char
- Hledger.Data.Types: hsymbol :: HistoricalPrice -> String
- Hledger.Data.Types: instance Eq Commodity
- Hledger.Data.Types: instance Ord Commodity
- Hledger.Data.Types: instance Read Commodity
- Hledger.Data.Types: instance Show Commodity
- Hledger.Data.Types: precision :: Commodity -> Int
- Hledger.Data.Types: price :: Amount -> Maybe Price
- Hledger.Data.Types: quantity :: Amount -> Quantity
- Hledger.Data.Types: separator :: Commodity -> Char
- Hledger.Data.Types: separatorpositions :: Commodity -> [Int]
- Hledger.Data.Types: side :: Commodity -> Side
- Hledger.Data.Types: spaced :: Commodity -> Bool
- Hledger.Data.Types: symbol :: Commodity -> String
- Hledger.Read: amount :: GenParser Char JournalContext MixedAmount
- Hledger.Read: amount' :: String -> MixedAmount
- Hledger.Read.JournalReader: amount :: GenParser Char JournalContext MixedAmount
- Hledger.Read.JournalReader: amount' :: String -> MixedAmount
- Hledger.Utils: ltrace :: Show a => String -> a -> a
+ Hledger.Data.Amount: (@@) :: Amount -> Amount -> Amount
+ Hledger.Data.Amount: amount :: Amount
+ Hledger.Data.Amount: amountstyle :: AmountStyle
+ Hledger.Data.Amount: at :: Amount -> Amount -> Amount
+ Hledger.Data.Amount: canonicalStyles :: [Amount] -> Map Commodity AmountStyle
+ Hledger.Data.Amount: canonicaliseAmount :: Map Commodity AmountStyle -> Amount -> Amount
+ Hledger.Data.Amount: canonicaliseMixedAmount :: Map Commodity AmountStyle -> MixedAmount -> MixedAmount
+ Hledger.Data.Amount: eur :: Quantity -> Amount
+ Hledger.Data.Amount: gbp :: Quantity -> Amount
+ Hledger.Data.Amount: hrs :: Quantity -> Amount
+ Hledger.Data.Amount: mixed :: Amount -> MixedAmount
+ Hledger.Data.Amount: num :: Quantity -> Amount
+ Hledger.Data.Amount: usd :: Quantity -> Amount
+ Hledger.Data.Amount: withPrecision :: Amount -> Int -> Amount
+ Hledger.Data.Commodity: commodity :: [Char]
+ Hledger.Data.Commodity: commoditysymbols :: [([Char], [Char])]
+ Hledger.Data.Types: AmountStyle :: Side -> Bool -> Int -> Char -> Char -> [Int] -> AmountStyle
+ Hledger.Data.Types: NoPrice :: Price
+ Hledger.Data.Types: acommodity :: Amount -> Commodity
+ Hledger.Data.Types: aprice :: Amount -> Price
+ Hledger.Data.Types: aquantity :: Amount -> Quantity
+ Hledger.Data.Types: ascommodityside :: AmountStyle -> Side
+ Hledger.Data.Types: ascommodityspaced :: AmountStyle -> Bool
+ Hledger.Data.Types: asdecimalpoint :: AmountStyle -> Char
+ Hledger.Data.Types: asprecision :: AmountStyle -> Int
+ Hledger.Data.Types: asseparator :: AmountStyle -> Char
+ Hledger.Data.Types: asseparatorpositions :: AmountStyle -> [Int]
+ Hledger.Data.Types: astyle :: Amount -> AmountStyle
+ Hledger.Data.Types: ctxCommodityAndStyle :: JournalContext -> !(Maybe (Commodity, AmountStyle))
+ Hledger.Data.Types: data AmountStyle
+ Hledger.Data.Types: hcommodity :: HistoricalPrice -> Commodity
+ Hledger.Data.Types: instance Eq AmountStyle
+ Hledger.Data.Types: instance Ord AmountStyle
+ Hledger.Data.Types: instance Read AmountStyle
+ Hledger.Data.Types: instance Show AmountStyle
+ Hledger.Data.Types: jcommoditystyles :: Journal -> Map Commodity AmountStyle
+ Hledger.Data.Types: skipLines :: CsvRules -> Int
+ Hledger.Data.Types: type Commodity = String
+ Hledger.Read: amountp :: GenParser Char JournalContext Amount
+ Hledger.Read: amountp' :: String -> Amount
+ Hledger.Read: mamountp' :: String -> MixedAmount
+ Hledger.Read.JournalReader: amountp :: GenParser Char JournalContext Amount
+ Hledger.Read.JournalReader: amountp' :: String -> Amount
+ Hledger.Read.JournalReader: mamountp' :: String -> MixedAmount
+ Hledger.Utils: lstrace :: Show a => String -> a -> a
- Hledger.Data.Journal: journalAmounts :: Journal -> [MixedAmount]
+ Hledger.Data.Journal: journalAmounts :: Journal -> [Amount]
- Hledger.Data.Ledger: ledgerCommodities :: Ledger -> Map String Commodity
+ Hledger.Data.Ledger: ledgerCommodities :: Ledger -> [Commodity]
- Hledger.Data.Transaction: balanceTransaction :: Maybe (Map String Commodity) -> Transaction -> Either String Transaction
+ Hledger.Data.Transaction: balanceTransaction :: Maybe (Map Commodity AmountStyle) -> Transaction -> Either String Transaction
- Hledger.Data.Transaction: isTransactionBalanced :: Maybe (Map String Commodity) -> Transaction -> Bool
+ Hledger.Data.Transaction: isTransactionBalanced :: Maybe (Map Commodity AmountStyle) -> Transaction -> Bool
- Hledger.Data.Types: Amount :: Commodity -> Quantity -> Maybe Price -> Amount
+ Hledger.Data.Types: Amount :: Commodity -> Quantity -> Price -> AmountStyle -> Amount
- Hledger.Data.Types: CsvRules :: Maybe FieldPosition -> Maybe String -> Maybe FieldPosition -> Maybe FieldPosition -> [FormatString] -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe String -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe FieldPosition -> AccountName -> [AccountRule] -> CsvRules
+ Hledger.Data.Types: CsvRules :: Maybe FieldPosition -> Maybe String -> Maybe FieldPosition -> Maybe FieldPosition -> [FormatString] -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe String -> Maybe FieldPosition -> Maybe FieldPosition -> Maybe FieldPosition -> AccountName -> [AccountRule] -> Int -> CsvRules
- Hledger.Data.Types: Ctx :: !(Maybe Year) -> !(Maybe Commodity) -> ![AccountName] -> ![(AccountName, AccountName)] -> JournalContext
+ Hledger.Data.Types: Ctx :: !(Maybe Year) -> !(Maybe (Commodity, AmountStyle)) -> ![AccountName] -> ![(AccountName, AccountName)] -> JournalContext
- Hledger.Data.Types: HistoricalPrice :: Day -> String -> MixedAmount -> HistoricalPrice
+ Hledger.Data.Types: HistoricalPrice :: Day -> Commodity -> Amount -> HistoricalPrice
- Hledger.Data.Types: Journal :: [ModifierTransaction] -> [PeriodicTransaction] -> [Transaction] -> [TimeLogEntry] -> [HistoricalPrice] -> String -> JournalContext -> [(FilePath, String)] -> ClockTime -> Journal
+ Hledger.Data.Types: Journal :: [ModifierTransaction] -> [PeriodicTransaction] -> [Transaction] -> [TimeLogEntry] -> [HistoricalPrice] -> String -> JournalContext -> [(FilePath, String)] -> ClockTime -> Map Commodity AmountStyle -> Journal
- Hledger.Data.Types: TotalPrice :: MixedAmount -> Price
+ Hledger.Data.Types: TotalPrice :: Amount -> Price
- Hledger.Data.Types: UnitPrice :: MixedAmount -> Price
+ Hledger.Data.Types: UnitPrice :: Amount -> Price
- Hledger.Data.Types: hamount :: HistoricalPrice -> MixedAmount
+ Hledger.Data.Types: hamount :: HistoricalPrice -> Amount
Files
- Hledger/Data/Amount.hs +190/−140
- Hledger/Data/Commodity.hs +33/−31
- Hledger/Data/Journal.hs +56/−52
- Hledger/Data/Ledger.hs +3/−3
- Hledger/Data/TimeLog.hs +3/−3
- Hledger/Data/Transaction.hs +67/−71
- Hledger/Data/Types.hs +27/−26
- Hledger/Read.hs +3/−2
- Hledger/Read/CsvReader.hs +16/−6
- Hledger/Read/JournalReader.hs +78/−84
- Hledger/Reports.hs +49/−56
- Hledger/Utils.hs +3/−3
- hledger-lib.cabal +2/−3
Hledger/Data/Amount.hs view
@@ -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,39 @@ module Hledger.Data.Amount ( -- * Amount+ amount, nullamt, missingamt,+ num,+ 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,+ mixed, amounts, normaliseMixedAmountPreservingFirstPrice, normaliseMixedAmountPreservingPrices,- canonicaliseMixedAmountCommodity,- mixedAmountWithCommodity,- setMixedAmountPrecision, -- ** arithmetic costOfMixedAmount, divideMixedAmount,@@ -78,6 +87,8 @@ showMixedAmountDebug, showMixedAmountWithoutPrice, showMixedAmountWithPrecision,+ setMixedAmountPrecision,+ canonicaliseMixedAmount, -- * misc. ltraceamount, tests_Hledger_Data_Amount@@ -86,9 +97,10 @@ 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 +109,75 @@ 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, nullamt :: Amount+amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, 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+num 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=NoPrice} -- | 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=UnitPrice priceamt}++-- | Set an amount's total price.+(@@) :: Amount -> Amount -> Amount+amt @@ priceamt = amt{aprice=TotalPrice 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 +187,19 @@ -- -- - 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- _ -> error' "costOfAmount: Malformed price encountered, programmer error"+ NoPrice -> a+ UnitPrice p@Amount{aquantity=pq} -> p{aquantity=pq * q}+ TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q} -- | 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 @@ -- 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,53 +220,59 @@ 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) (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=NoPrice} -- | 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=NoPrice} showPrice :: Price -> String-showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa-showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa+showPrice NoPrice = ""+showPrice (UnitPrice pa) = " @ " ++ showAmount pa+showPrice (TotalPrice pa) = " @@ " ++ showAmount pa showPriceDebug :: Price -> String-showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa-showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa+showPriceDebug NoPrice = ""+showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa+showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa -- | Get the string representation of an amount, based on its commodity's -- 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 = 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 +282,8 @@ | 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 +312,12 @@ 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 +325,7 @@ 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,11 +338,14 @@ -- | 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] +mixed :: Amount -> MixedAmount+mixed a = Mixed [a]+ -- | Simplify a mixed amount's component amounts: we can combine amounts -- with the same commodity and unit price. Also remove any zero or missing -- amounts and replace an empty amount list with a single zero amount.@@ -312,30 +353,29 @@ 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- (Nothing, Nothing) -> True- (Just (UnitPrice p1), Just (UnitPrice p2)) -> p1 == p2+ case (aprice a1, aprice a2) of+ (NoPrice, NoPrice) -> True+ (UnitPrice p1, 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 +391,8 @@ 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 +401,7 @@ -- 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 +435,6 @@ 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 +447,7 @@ -- 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,15 +476,31 @@ 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=NoPrice} 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 +512,78 @@ -- 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=UnitPrice $ usd 2} `is` usd 4+ costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2+ costOfAmount (eur (-1)){aprice=TotalPrice $ 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=UnitPrice $ 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 = usd 1 `withPrecision` 1+ ap3 = usd 1 `withPrecision` 3+ (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+ ,usd (-1) `withPrecision` 0+ ,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"
Hledger/Data/Commodity.hs view
@@ -9,10 +9,9 @@ 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 @@ quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\"" | otherwise = s --- convenient amount and commodity constructors, for tests etc.--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=[]}+commodity = "" -dollars n = Amount dollar n Nothing-euros n = Amount euro n Nothing-pounds n = Amount pound n Nothing-hours n = Amount hour n Nothing+-- handy constructors for tests+-- unknown = commodity+-- usd = "$"+-- eur = "€"+-- gbp = "£"+-- hour = "h" -defaultcommodities = [dollar, euro, pound, hour, unknown]+-- Some sample commodity' names and symbols, for use in tests..+commoditysymbols =+ [("unknown","")+ ,("usd","$")+ ,("eur","€")+ ,("gbp","£")+ ,("hour","h")+ ] --- | 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 [ ]
Hledger/Data/Journal.hs view
@@ -25,9 +25,9 @@ -- * Querying journalAccountNames, journalAccountNamesUsed,- journalAmountAndPriceCommodities,+ -- journalAmountAndPriceCommodities, journalAmounts,- journalCanonicalCommodities,+ -- journalCanonicalCommodities, journalDateSpan, journalFilePath, journalFilePaths,@@ -51,7 +51,7 @@ ) 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 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 @@ 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 @@ , 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,25 +371,29 @@ -- 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 -- journalApplyHistoricalPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}@@ -421,31 +427,35 @@ 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. journalDateSpan :: Journal -> DateSpan@@ -475,8 +485,8 @@ 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 @@ -- 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 @@ Posting { pstatus=False, paccount="assets:bank:checking",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -550,7 +559,7 @@ Posting { pstatus=False, paccount="assets:bank:checking",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -581,7 +590,7 @@ Posting { pstatus=False, paccount="assets:bank:saving",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -590,7 +599,7 @@ Posting { pstatus=False, paccount="assets:bank:checking",- pamount=(Mixed [dollars (-1)]),+ pamount=(Mixed [usd (-1)]), pcomment="", ptype=RegularPosting, ptags=[],@@ -612,7 +621,7 @@ Posting { pstatus=False, paccount="expenses:food",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -621,7 +630,7 @@ Posting { pstatus=False, paccount="expenses:supplies",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -652,7 +661,7 @@ Posting { pstatus=False, paccount="liabilities:debts",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -661,7 +670,7 @@ Posting { pstatus=False, paccount="assets:bank:checking",- pamount=(Mixed [dollars (-1)]),+ pamount=(Mixed [usd (-1)]), pcomment="", ptype=RegularPosting, ptags=[],@@ -671,12 +680,7 @@ tpreceding_comment_lines="" } ]- []- []- ""- nullctx- []- (TOD 0 0)+ } tests_Hledger_Data_Journal = TestList $ [
Hledger/Data/Ledger.hs view
@@ -82,9 +82,9 @@ 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 = [
Hledger/Data/TimeLog.hs view
@@ -20,7 +20,7 @@ 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 @@ 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}]
Hledger/Data/Transaction.hs view
@@ -47,7 +47,6 @@ 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 @@ 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 @@ 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 @@ -- | 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 @@ -- 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 @@ -- 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 ((==NoPrice).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=NoPrice}], 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)]- | otherwise = Nothing+ then TotalPrice $ abs targetcommodityamount `withPrecision` maxprecision+ else UnitPrice $ abs (targetcommodityamount `divideAmount` (aquantity unpricedamount)) `withPrecision` maxprecision+ | otherwise = NoPrice 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 ((==NoPrice).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=NoPrice}], 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)]- | otherwise = Nothing+ then TotalPrice $ abs targetcommodityamount `withPrecision` maxprecision+ else UnitPrice $ abs (targetcommodityamount `divideAmount` (aquantity unpricedamount)) `withPrecision` maxprecision+ | otherwise = NoPrice 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 @@ ,"" ]) (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 @@ ,"" ]) (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 @@ ]) (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 @@ ]) (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 @@ ]) (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 [num 1 `at` (usd 2 `withPrecision` 0)]) "" RegularPosting [] Nothing ,Posting False "b" missingmixedamt "" RegularPosting [] Nothing ] "")) @@ -452,8 +452,8 @@ 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 @@ ] "")) 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 @@ (eur 1 `withPrecision` maxprecision)]) (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)
Hledger/Data/Types.hs view
@@ -20,6 +20,7 @@ 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,29 @@ 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- deriving (Eq,Ord)+-- | An amount's price (none, per unit, or total) in another commodity.+-- Note the price should be a positive number, although this is not enforced.+data Price = NoPrice | UnitPrice Amount | TotalPrice Amount 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 :: Price, -- ^ the (fixed) price for this amount, if any+ astyle :: AmountStyle } deriving (Eq,Ord) newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord)@@ -124,8 +123,8 @@ data HistoricalPrice = HistoricalPrice { hdate :: Day,- hsymbol :: String,- hamount :: MixedAmount+ hcommodity :: Commodity,+ hamount :: Amount } deriving (Eq) -- & Show (in Amount.hs) type Year = Integer@@ -136,7 +135,7 @@ -- 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 +154,8 @@ -- 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@@ -203,7 +203,8 @@ account2Field :: Maybe FieldPosition, effectiveDateField :: Maybe FieldPosition, baseAccount :: AccountName,- accountRules :: [AccountRule]+ accountRules :: [AccountRule],+ skipLines :: Int } deriving (Show, Eq) type FieldPosition = Int
Hledger/Read.hs view
@@ -19,8 +19,9 @@ ensureJournalFileExists, -- * Parsers used elsewhere accountname,- amount,- amount',+ amountp,+ amountp',+ mamountp', -- * Tests samplejournal, tests_Hledger_Read,
Hledger/Read/CsvReader.hs view
@@ -61,7 +61,7 @@ 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@@ -98,7 +98,8 @@ account2Field=Nothing, effectiveDateField=Nothing, baseAccount="unknown",- accountRules=[]+ accountRules=[],+ skipLines=0 } type CsvRecord = [String]@@ -137,9 +138,10 @@ rules <- liftM (either (throw.userError.show) id) $ parseCsvRulesFile rulesfile let requiredfields = (maxFieldIndex rules + 1)- badrecords = take 1 $ filter ((< requiredfields).length) records+ realrecords = drop (skipLines rules) records+ badrecords = take 1 $ filter ((< requiredfields).length) realrecords return $ case badrecords of- [] -> Right nulljournal{jtxns=sortBy (comparing tdate) $ map (transactionFromCsvRecord rules) records}+ [] -> Right nulljournal{jtxns=sortBy (comparing tdate) $ map (transactionFromCsvRecord rules) realrecords} (_:_) -> Left $ "Parse error: at least one CSV record does not contain a field referenced by the conversion rules file:\n"++(show $ head badrecords) -- | Ensure there is a conversion rules file at the given path, creating a@@ -189,6 +191,7 @@ "# Add rules to this file for more accurate conversion, see\n"++ "# http://hledger.org/MANUAL.html#convert\n" ++ "\n" +++ "skip-lines 0\n" ++ "base-account assets:bank:checking\n" ++ "date-field 0\n" ++ "description-field 4\n" ++@@ -251,6 +254,7 @@ ,effectivedatefield ,basecurrency ,baseaccount+ ,skiplines ,commentline ] <?> "definition" return ()@@ -350,6 +354,12 @@ optional newline updateState (\r -> r{baseAccount=v}) +skiplines = do+ string "skip-lines"+ many1 spacenonewline+ v <- restofline+ updateState (\r -> r{skipLines=read v})+ accountrule :: GenParser Char CsvRules AccountRule accountrule = do many blankorcommentline@@ -426,8 +436,8 @@ strnegate s = '-':s currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules) amountstr'' = currency ++ amountstr'- amountparse = runParser amount nullctx "" amountstr''- a = either (const nullmixedamt) id amountparse+ amountparse = runParser amountp nullctx "" amountstr''+ a = either (const nullmixedamt) mixed 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" baseamount = costOfMixedAmount a
Hledger/Read/JournalReader.hs view
@@ -27,8 +27,9 @@ historicalpricedirective, datetime, accountname,- amount,- amount',+ amountp,+ amountp',+ mamountp', emptyline, -- * Tests tests_Hledger_Read_JournalReader@@ -102,11 +103,11 @@ 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 +255,8 @@ defaultcommoditydirective = do char 'D' <?> "default commodity" many1 spacenonewline- a <- amount- -- 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+ Amount{..} <- amountp+ setCommodityAndStyle (acommodity, astyle) restofline return $ return id @@ -269,7 +268,7 @@ many1 spacenonewline symbol <- commoditysymbol many spacenonewline- price <- amount+ price <- amountp restofline return $ HistoricalPrice date symbol price @@ -285,11 +284,11 @@ commodityconversiondirective = do char 'C' <?> "commodity conversion" many1 spacenonewline- amount+ amountp many spacenonewline char '=' many spacenonewline- amount+ amountp restofline return $ return id @@ -370,7 +369,7 @@ 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 +513,7 @@ 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,78 +557,76 @@ spaceandamountormissing = try (do many1 spacenonewline- amount <|> return missingmixedamt+ (Mixed . (:[])) `fmap` 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 ] --- | 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+-- | Parse a single-commodity amount, with optional symbol on the left or+-- right, optional unit or total price, and optional (ignored)+-- ledger-style balance assertion or fixed lot price declaration.+amountp :: GenParser Char JournalContext Amount+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") (usd 47.18)+ assertParseEqual (parseWithCtx nullctx amountp "$1.") (usd 1 `withPrecision` 0) ,"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")+ (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")+ (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+-- | Parse an amount from a string, or get an error.+amountp' :: String -> Amount+amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s -leftsymbolamount :: GenParser Char JournalContext MixedAmount+-- | Parse a mixed amount from a string, or get an error.+mamountp' :: String -> MixedAmount+mamountp' = mixed . amountp'++leftsymbolamount :: GenParser Char JournalContext Amount leftsymbolamount = do 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 $ Amount c q p s <?> "left-symbol amount" -rightsymbolamount :: GenParser Char JournalContext MixedAmount+rightsymbolamount :: GenParser Char JournalContext Amount 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 $ Amount c q p s <?> "right-symbol amount" -nosymbolamount :: GenParser Char JournalContext MixedAmount+nosymbolamount :: GenParser Char JournalContext Amount 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 $ Amount c q p s <?> "no-symbol amount" commoditysymbol :: GenParser Char JournalContext String@@ -645,7 +642,7 @@ simplecommoditysymbol :: GenParser Char JournalContext String simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars) -priceamount :: GenParser Char JournalContext (Maybe Price)+priceamount :: GenParser Char JournalContext Price priceamount = try (do many spacenonewline@@ -653,26 +650,26 @@ try (do char '@' many spacenonewline- a <- amount -- XXX can parse more prices ad infinitum, shouldn't- return $ Just $ TotalPrice a)+ a <- amountp -- XXX can parse more prices ad infinitum, shouldn't+ return $ TotalPrice a) <|> (do many spacenonewline- a <- amount -- XXX can parse more prices ad infinitum, shouldn't- return $ Just $ UnitPrice a))- <|> return Nothing+ a <- amountp -- XXX can parse more prices ad infinitum, shouldn't+ return $ UnitPrice a))+ <|> return NoPrice -balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)+balanceassertion :: GenParser Char JournalContext (Maybe Amount) balanceassertion = try (do 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 -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices-fixedlotprice :: GenParser Char JournalContext (Maybe MixedAmount)+fixedlotprice :: GenParser Char JournalContext (Maybe Amount) fixedlotprice = try (do many spacenonewline@@ -680,7 +677,7 @@ 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 +838,7 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ tests_number,- tests_amount,+ tests_amountp, tests_spaceandamountormissing, tests_tagcomment, tests_inlinecomment,@@ -891,7 +888,7 @@ 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" $ usd 55) ,"ignoredpricecommoditydirective" ~: do assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n")@@ -916,19 +913,16 @@ 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") (usd 1 `withPrecision` 0)+ assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (usd (-1) `withPrecision` 0)+ assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (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])])+ let -- | compare a parse result with an expected amount, showing the debug representation for clarity+ assertAmountParse parseresult amount =+ (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount)+ assertAmountParse (parseWithCtx nullctx amountp "1 @ $2")+ (num 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0)) ]] @@ -941,6 +935,6 @@ 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] ""
Hledger/Reports.hs view
@@ -56,13 +56,12 @@ -- 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 (mamountp') import Hledger.Query import Hledger.Utils @@ -425,7 +424,7 @@ 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 @@ ,"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, mamountp' "$-1.00")+ ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00")+ ,("assets:cash","cash",1, mamountp' "$-2.00")+ ,("expenses","expenses",0, mamountp' "$2.00")+ ,("expenses:food","food",1, mamountp' "$1.00")+ ,("expenses:supplies","supplies",1, mamountp' "$1.00")+ ,("income","income",0, mamountp' "$-2.00")+ ,("income:gifts","gifts",1, mamountp' "$-1.00")+ ,("income:salary","salary",1, mamountp' "$-1.00")+ ,("liabilities:debts","liabilities:debts",0, mamountp' "$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, mamountp' "$-1.00")+ ,("expenses", "expenses", 0, mamountp' "$2.00")+ ,("income", "income", 0, mamountp' "$-2.00")+ ,("liabilities", "liabilities", 0, mamountp' "$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, mamountp' "$-1.00")+ ,("expenses", "expenses", 0, mamountp' "$2.00")+ ,("income", "income", 0, mamountp' "$-2.00")+ ,("liabilities", "liabilities", 0, mamountp' "$1.00") ], Mixed [nullamt]) @@ -799,32 +798,32 @@ 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,mamountp' "$1.00")+ ,("income:salary","income:salary",0,mamountp' "$-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,mamountp' "$1.00")+ ,("income:salary","income:salary",0, mamountp' "$-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, mamountp' "$-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,mamountp' "$-1.00")+ ,("assets:bank:saving","saving",2, mamountp' "$1.00")+ ,("assets:cash","cash",1, mamountp' "$-2.00")+ ,("expenses","expenses",0, mamountp' "$2.00")+ ,("expenses:food","food",1, mamountp' "$1.00")+ ,("expenses:supplies","supplies",1, mamountp' "$1.00")+ ,("income:gifts","income:gifts",0, mamountp' "$-1.00")+ ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00") ], Mixed [nullamt]) @@ -945,10 +944,9 @@ -} ] -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 @@ Posting { pstatus=False, paccount="assets:bank:checking",- pamount=(Mixed [dollars 1]),+ pamount=(Mixed [usd 1]), pcomment="", ptype=RegularPosting, ptags=[],@@ -980,13 +978,8 @@ 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 @@ -- (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 @@ -- ] -- ("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]} -- ] ]
Hledger/Utils.hs view
@@ -326,9 +326,9 @@ strace :: Show a => a -> a strace a = trace (show a) a --- | labelled trace - like strace, with a label prepended-ltrace :: Show a => String -> a -> a-ltrace l a = trace (l ++ ": " ++ show a) a+-- | labelled trace showable - like strace, with a label prepended+lstrace :: Show a => String -> a -> a+lstrace l a = trace (l ++ ": " ++ show a) a -- | monadic trace - like strace, but works as a standalone line in a monad mtrace :: (Monad m, Show a) => a -> m a
hledger-lib.cabal view
@@ -1,5 +1,5 @@ name: hledger-lib-version: 0.19.1+version: 0.19.3 category: Finance synopsis: Core data types, parsers and utilities for the hledger accounting tool. description:@@ -68,7 +68,6 @@ ,parsec ,regexpr >= 0.5.1 ,safe >= 0.2- ,shakespeare-text >= 1.0 && < 1.1 ,split >= 0.1 && < 0.3 ,time ,transformers >= 0.2 && < 0.4@@ -77,7 +76,7 @@ source-repository head type: darcs- location: http://joyful.com/repos/hledger+ location: http://hub.darcs.net/simon/hledger -- cf http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html