journal: use groups sep and prec for decimal hint
Use whole AmountStyle in process of resolving decimal/groups separator ambiguity. Resolve simonmichael/hledger#399
This commit is contained in:
		
							parent
							
								
									7cbdeb40a4
								
							
						
					
					
						commit
						e58272f28f
					
				| @ -14,6 +14,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. | ||||
| 
 | ||||
| --- * module | ||||
| {-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} | ||||
| {-# LANGUAGE LambdaCase #-} | ||||
| 
 | ||||
| module Hledger.Read.Common | ||||
| where | ||||
| @ -146,15 +147,23 @@ setDefaultCommodityAndStyle cs = modify' (\j -> j{jparsedefaultcommodity=Just cs | ||||
| getDefaultCommodityAndStyle :: JournalParser m (Maybe (CommoditySymbol,AmountStyle)) | ||||
| getDefaultCommodityAndStyle = jparsedefaultcommodity `fmap` get | ||||
| 
 | ||||
| getDefaultDecimalHint :: JournalParser m (Maybe Char) | ||||
| getDefaultDecimalHint = maybe Nothing (asdecimalpoint . snd) <$> getDefaultCommodityAndStyle | ||||
| -- | Get amount style associated with default currency. | ||||
| -- | ||||
| -- Returns 'AmountStyle' used to defined by a latest default commodity directive | ||||
| -- prior to current position within this file or its parents. | ||||
| getDefaultAmountStyle :: JournalParser m (Maybe AmountStyle) | ||||
| getDefaultAmountStyle = fmap snd <$> getDefaultCommodityAndStyle | ||||
| 
 | ||||
| getDecimalHint :: CommoditySymbol -> JournalParser m (Maybe Char) | ||||
| getDecimalHint commodity = do | ||||
| -- | Lookup currency-specific amount style. | ||||
| -- | ||||
| -- Returns 'AmountStyle' used in commodity directive within current journal | ||||
| -- prior to current position or in its parents files. | ||||
| getAmountStyle :: CommoditySymbol -> JournalParser m (Maybe AmountStyle) | ||||
| getAmountStyle commodity = do | ||||
|     specificStyle <-  maybe Nothing cformat . M.lookup commodity . jcommodities <$> get | ||||
|     defaultStyle <- fmap snd <$> getDefaultCommodityAndStyle | ||||
|     let effectiveStyle = listToMaybe $ catMaybes [specificStyle, defaultStyle] | ||||
|     return $ maybe Nothing asdecimalpoint effectiveStyle | ||||
|     return effectiveStyle | ||||
| 
 | ||||
| pushAccount :: AccountName -> JournalParser m () | ||||
| pushAccount acct = modify' (\j -> j{jaccounts = acct : jaccounts j}) | ||||
| @ -426,9 +435,9 @@ leftsymbolamountp = do | ||||
|   sign <- lift signp | ||||
|   m <- lift multiplierp | ||||
|   c <- lift commoditysymbolp | ||||
|   decimalHint <- getDecimalHint c | ||||
|   suggestedStyle <- getAmountStyle c | ||||
|   sp <- lift $ many spacenonewline | ||||
|   (q,prec,mdec,mgrps) <- lift $ numberp decimalHint | ||||
|   (q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle | ||||
|   let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} | ||||
|   p <- priceamountp | ||||
|   let applysign = if sign=="-" then negate else id | ||||
| @ -442,8 +451,8 @@ rightsymbolamountp = do | ||||
|   rawnum <- lift $ rawnumberp | ||||
|   sp <- lift $ many spacenonewline | ||||
|   c <- lift commoditysymbolp | ||||
|   decimalHint <- getDecimalHint c | ||||
|   let (q,prec,mdec,mgrps) = fromRawNumber decimalHint (sign == "-") rawnum | ||||
|   suggestedStyle <- getAmountStyle c | ||||
|   let (q,prec,mdec,mgrps) = fromRawNumber suggestedStyle (sign == "-") rawnum | ||||
|   p <- priceamountp | ||||
|   let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} | ||||
|   return $ Amount c q p s m | ||||
| @ -452,8 +461,8 @@ rightsymbolamountp = do | ||||
| nosymbolamountp :: Monad m => JournalParser m Amount | ||||
| nosymbolamountp = do | ||||
|   m <- lift multiplierp | ||||
|   decimalHint <- getDefaultDecimalHint | ||||
|   (q,prec,mdec,mgrps) <- lift $ numberp decimalHint | ||||
|   suggestedStyle <- getDefaultAmountStyle | ||||
|   (q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle | ||||
|   p <- priceamountp | ||||
|   -- apply the most recently seen default commodity and style to this commodityless amount | ||||
|   defcs <- getDefaultCommodityAndStyle | ||||
| @ -540,26 +549,26 @@ fixedlotpricep = | ||||
| -- seen following the decimal point), the decimal point character used if any, | ||||
| -- and the digit group style if any. | ||||
| -- | ||||
| numberp :: Maybe Char -> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| numberp decimalHint = do | ||||
| numberp :: Maybe AmountStyle -> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| numberp suggestedStyle = do | ||||
|     -- a number is an optional sign followed by a sequence of digits possibly | ||||
|     -- interspersed with periods, commas, or both | ||||
|     -- ptrace "numberp" | ||||
|     sign <- signp | ||||
|     raw <- rawnumberp | ||||
|     dbg8 "numberp parsed" raw `seq` return () | ||||
|     return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (fromRawNumber decimalHint (sign == "-") raw) | ||||
|     return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (fromRawNumber suggestedStyle (sign == "-") raw) | ||||
|     <?> "numberp" | ||||
| 
 | ||||
| fromRawNumber :: Maybe Char -> Bool -> (Maybe Char, [String], Maybe (Char, String)) -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| fromRawNumber decimalHint negated raw = (quantity, precision, mdecimalpoint, mgrps) where | ||||
| fromRawNumber :: Maybe AmountStyle -> Bool -> (Maybe Char, [String], Maybe (Char, String)) -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| fromRawNumber suggestedStyle negated raw = (quantity, precision, mdecimalpoint, mgrps) where | ||||
|     -- unpack with a hint if useful | ||||
|     (mseparator, intparts, mdecimalpoint, frac) = | ||||
|             case raw of | ||||
|                 -- just a single punctuation between two digits groups, assume it's a decimal point | ||||
|                 (Just s, [firstGroup, lastGroup], Nothing) | ||||
|                     -- if have a decimalHint restrict this assumpion only to a matching separator | ||||
|                     | maybe True (s ==) decimalHint -> (Nothing, [firstGroup], Just s, lastGroup) | ||||
|                     | maybe True (`asdecimalcheck` s) suggestedStyle -> (Nothing, [firstGroup], Just s, lastGroup) | ||||
| 
 | ||||
|                 (firstSep, digitGroups, Nothing) -> (firstSep, digitGroups, Nothing, []) | ||||
|                 (firstSep, digitGroups, Just (d, frac)) -> (firstSep, digitGroups, Just d, frac) | ||||
| @ -575,6 +584,14 @@ fromRawNumber decimalHint negated raw = (quantity, precision, mdecimalpoint, mgr | ||||
|     quantity = read repr | ||||
|     precision = length frac | ||||
| 
 | ||||
|     asdecimalcheck :: AmountStyle -> Char -> Bool | ||||
|     asdecimalcheck = \case | ||||
|         AmountStyle{asdecimalpoint = Just d} -> (d ==) | ||||
|         AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> (g /=) | ||||
|         AmountStyle{asprecision = 0} -> const False | ||||
|         _ -> const True | ||||
| 
 | ||||
| 
 | ||||
| rawnumberp :: TextParser m (Maybe Char, [String], Maybe (Char, String)) | ||||
| rawnumberp = do | ||||
|     let sepChars = ['.', ','] -- all allowed punctuation characters | ||||
|  | ||||
| @ -100,6 +100,38 @@ commodity €1,000.00 | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # No decimals but have hint from commodity directive with groups | ||||
| hledger bal -f - | ||||
| <<< | ||||
| commodity 1,000,000 EUR | ||||
| 
 | ||||
| 2017/1/1 | ||||
| 	a   1,000 EUR | ||||
| 	b  -1,000.00 EUR | ||||
| >>> | ||||
|            1,000 EUR  a | ||||
|           -1,000 EUR  b | ||||
| -------------------- | ||||
|                    0 | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # No decimals but have hint from commodity directive with zero precision | ||||
| hledger bal -f - | ||||
| <<< | ||||
| commodity 100 EUR | ||||
| 
 | ||||
| 2017/1/1 | ||||
| 	a   1,000 EUR | ||||
| 	b  -1,000.00 EUR | ||||
| >>> | ||||
|             1000 EUR  a | ||||
|            -1000 EUR  b | ||||
| -------------------- | ||||
|                    0 | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # Big prices | ||||
| hledger bal -f -  --no-total | ||||
| <<< | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user