journal: use decimal sep hint for amount parser
Make use of commodity format directive as a hint for parsing amount. Kinda resolves simonmichael/hledger#487
This commit is contained in:
		
							parent
							
								
									dafdaec1ca
								
							
						
					
					
						commit
						b7dbe044b0
					
				| @ -30,6 +30,7 @@ import Data.List.Compat | ||||
| import Data.List.NonEmpty (NonEmpty(..)) | ||||
| import Data.List.Split (wordsBy) | ||||
| import Data.Maybe | ||||
| import qualified Data.Map as M | ||||
| import Data.Monoid | ||||
| import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| @ -145,6 +146,12 @@ 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 | ||||
| 
 | ||||
| getDecimalHint :: CommoditySymbol -> JournalParser m (Maybe Char) | ||||
| getDecimalHint commodity = maybe Nothing asdecimalpoint . maybe Nothing cformat . M.lookup commodity . jcommodities <$> get | ||||
| 
 | ||||
| pushAccount :: AccountName -> JournalParser m () | ||||
| pushAccount acct = modify' (\j -> j{jaccounts = acct : jaccounts j}) | ||||
| 
 | ||||
| @ -415,8 +422,9 @@ leftsymbolamountp = do | ||||
|   sign <- lift signp | ||||
|   m <- lift multiplierp | ||||
|   c <- lift commoditysymbolp | ||||
|   decimalHint <- getDecimalHint c | ||||
|   sp <- lift $ many spacenonewline | ||||
|   (q,prec,mdec,mgrps) <- lift numberp | ||||
|   (q,prec,mdec,mgrps) <- lift $ numberp decimalHint | ||||
|   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 | ||||
| @ -426,9 +434,12 @@ leftsymbolamountp = do | ||||
| rightsymbolamountp :: Monad m => JournalParser m Amount | ||||
| rightsymbolamountp = do | ||||
|   m <- lift multiplierp | ||||
|   (q,prec,mdec,mgrps) <- lift numberp | ||||
|   sign <- lift signp | ||||
|   rawnum <- lift $ rawnumberp | ||||
|   sp <- lift $ many spacenonewline | ||||
|   c <- lift commoditysymbolp | ||||
|   decimalHint <- getDecimalHint c | ||||
|   let (q,prec,mdec,mgrps) = fromRawNumber decimalHint (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 | ||||
| @ -437,7 +448,8 @@ rightsymbolamountp = do | ||||
| nosymbolamountp :: Monad m => JournalParser m Amount | ||||
| nosymbolamountp = do | ||||
|   m <- lift multiplierp | ||||
|   (q,prec,mdec,mgrps) <- lift numberp | ||||
|   decimalHint <- getDefaultDecimalHint | ||||
|   (q,prec,mdec,mgrps) <- lift $ numberp decimalHint | ||||
|   p <- priceamountp | ||||
|   -- apply the most recently seen default commodity and style to this commodityless amount | ||||
|   defcs <- getDefaultCommodityAndStyle | ||||
| @ -524,25 +536,26 @@ fixedlotpricep = | ||||
| -- seen following the decimal point), the decimal point character used if any, | ||||
| -- and the digit group style if any. | ||||
| -- | ||||
| numberp :: TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| numberp = do | ||||
| numberp :: Maybe Char -> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| numberp decimalHint = 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 (sign == "-") raw) | ||||
|     return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (fromRawNumber decimalHint (sign == "-") raw) | ||||
|     <?> "numberp" | ||||
| 
 | ||||
| fromRawNumber :: Bool -> (Maybe Char, [String], Maybe (Char, String)) -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) | ||||
| fromRawNumber negated raw = (quantity, precision, mdecimalpoint, mgrps) where | ||||
| 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 | ||||
|     -- 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) | ||||
|                     -> (Nothing, [firstGroup], Just s, lastGroup) | ||||
|                     -- if have a decimalHint restrict this assumpion only to a matching separator | ||||
|                     | maybe True (s ==) decimalHint -> (Nothing, [firstGroup], Just s, lastGroup) | ||||
| 
 | ||||
|                 (firstSep, digitGroups, Nothing) -> (firstSep, digitGroups, Nothing, []) | ||||
|                 (firstSep, digitGroups, Just (d, frac)) -> (firstSep, digitGroups, Just d, frac) | ||||
|  | ||||
| @ -141,7 +141,7 @@ timedotdurationp = try timedotnumericp <|> timedotdotsp | ||||
| -- @ | ||||
| timedotnumericp :: JournalParser m Quantity | ||||
| timedotnumericp = do | ||||
|   (q, _, _, _) <- lift numberp | ||||
|   (q, _, _, _) <- lift $ numberp Nothing | ||||
|   msymbol <- optional $ choice $ map (string . fst) timeUnits | ||||
|   lift (many spacenonewline) | ||||
|   let q' =  | ||||
|  | ||||
| @ -43,6 +43,22 @@ hledger bal -f - | ||||
| >>> | ||||
| >>>=1 | ||||
| 
 | ||||
| # Default commodity | ||||
| hledger bal -f - | ||||
| <<< | ||||
| D 1,000.00 EUR | ||||
| 
 | ||||
| 2017/1/1 | ||||
| 	a   1,000 | ||||
| 	b  -1,000.00 | ||||
| >>> | ||||
|         1,000.00 EUR  a | ||||
|        -1,000.00 EUR  b | ||||
| -------------------- | ||||
|                    0 | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # Omitted decimals | ||||
| hledger bal -f - | ||||
| <<< | ||||
| @ -52,6 +68,38 @@ hledger bal -f - | ||||
| >>> | ||||
| >>>=1 | ||||
| 
 | ||||
| # Omitted decimals with commodity hint | ||||
| hledger bal -f - | ||||
| <<< | ||||
| commodity 1,000.00 EUR | ||||
| 
 | ||||
| 2017/1/1 | ||||
| 	a   1,000 EUR | ||||
| 	b  -1,000.00 EUR | ||||
| >>> | ||||
|         1,000.00 EUR  a | ||||
|        -1,000.00 EUR  b | ||||
| -------------------- | ||||
|                    0 | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # Omitted decimals with commodity hint and symbol on left | ||||
| hledger bal -f - | ||||
| <<< | ||||
| commodity €1,000.00 | ||||
| 
 | ||||
| 2017/1/1 | ||||
| 	a   €1,000 | ||||
| 	b  €-1,000.00 | ||||
| >>> | ||||
|            €1,000.00  a | ||||
|           €-1,000.00  b | ||||
| -------------------- | ||||
|                    0 | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # Big prices | ||||
| hledger bal -f -  --no-total | ||||
| <<< | ||||
| @ -61,6 +109,20 @@ hledger bal -f -  --no-total | ||||
| >>> | ||||
| >>>=1 | ||||
| 
 | ||||
| # Big prices with commodity hint | ||||
| hledger bal -f -  --no-total | ||||
| <<< | ||||
| commodity ₴1,000.00 | ||||
| 
 | ||||
| 2017/1/1 | ||||
| 	a   -1 BTC @ ₴24,840 | ||||
| 	b   ₴24,840.00 | ||||
| >>> | ||||
|               -1 BTC  a | ||||
|           ₴24,840.00  b | ||||
| >>>2 | ||||
| >>>=0 | ||||
| 
 | ||||
| # adjacent punctuation chars | ||||
| hledger bal -f - | ||||
| <<< | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user