packages feed

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