diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index ea4fb2a11..1a540ca0b 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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) diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index cfea7a32e..9a433a5d2 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -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' = diff --git a/tests/journal/numbers.test b/tests/journal/numbers.test index 68902f85a..4b49886c2 100644 --- a/tests/journal/numbers.test +++ b/tests/journal/numbers.test @@ -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 - <<<