From e58272f28f4612568123c998c5d2608cca861379 Mon Sep 17 00:00:00 2001 From: Mykola Orliuk Date: Sun, 5 Nov 2017 00:40:54 +0100 Subject: [PATCH] journal: use groups sep and prec for decimal hint Use whole AmountStyle in process of resolving decimal/groups separator ambiguity. Resolve simonmichael/hledger#399 --- hledger-lib/Hledger/Read/Common.hs | 51 ++++++++++++++++++++---------- tests/journal/numbers.test | 32 +++++++++++++++++++ 2 files changed, 66 insertions(+), 17 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 01f0b0c75..ea3a1bc04 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 diff --git a/tests/journal/numbers.test b/tests/journal/numbers.test index 005e25d68..b81669c95 100644 --- a/tests/journal/numbers.test +++ b/tests/journal/numbers.test @@ -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 <<<