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