parsing: don't accept . as a valid amount
This commit is contained in:
parent
dcdb032d96
commit
4b4715ab76
@ -751,20 +751,21 @@ numberp = do
|
|||||||
sign <- optionMaybe $ string "-"
|
sign <- optionMaybe $ string "-"
|
||||||
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
|
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
|
||||||
let numeric = isNumber . headDef '_'
|
let numeric = isNumber . headDef '_'
|
||||||
(_, puncparts) = partition numeric parts
|
(numparts, puncparts) = partition numeric parts
|
||||||
(ok,decimalpoint',separator') =
|
(ok,decimalpoint',separator') =
|
||||||
case puncparts of
|
case (numparts,puncparts) of
|
||||||
[] -> (True, Nothing, Nothing) -- no punctuation chars
|
([],_) -> (False, Nothing, Nothing) -- no digits
|
||||||
[d:""] -> (True, Just d, Nothing) -- just one punctuation char, assume it's a decimal point
|
(_,[]) -> (True, Nothing, Nothing) -- no punctuation chars
|
||||||
[_] -> (False, Nothing, Nothing) -- adjacent punctuation chars, not ok
|
(_,[d:""]) -> (True, Just d, Nothing) -- just one punctuation char, assume it's a decimal point
|
||||||
_:_:_ -> let (s:ss, d) = (init puncparts, last puncparts) -- two or more punctuation chars
|
(_,[_]) -> (False, Nothing, Nothing) -- adjacent punctuation chars, not ok
|
||||||
in if (any ((/=1).length) puncparts -- adjacent punctuation chars, not ok
|
(_,_:_:_) -> let (s:ss, d) = (init puncparts, last puncparts) -- two or more punctuation chars
|
||||||
|| any (s/=) ss -- separator chars differ, not ok
|
in if (any ((/=1).length) puncparts -- adjacent punctuation chars, not ok
|
||||||
|| head parts == s) -- number begins with a separator char, not ok
|
|| any (s/=) ss -- separator chars differ, not ok
|
||||||
then (False, Nothing, Nothing)
|
|| head parts == s) -- number begins with a separator char, not ok
|
||||||
else if s == d
|
then (False, Nothing, Nothing)
|
||||||
then (True, Nothing, Just $ head s) -- just one kind of punctuation, assume separator chars
|
else if s == d
|
||||||
else (True, Just $ head d, Just $ head s) -- separators and a decimal point
|
then (True, Nothing, Just $ head s) -- just one kind of punctuation, assume separator chars
|
||||||
|
else (True, Just $ head d, Just $ head s) -- separators and a decimal point
|
||||||
when (not ok) (fail $ "number seems ill-formed: "++concat parts)
|
when (not ok) (fail $ "number seems ill-formed: "++concat parts)
|
||||||
let (intparts',fracparts') = span ((/= decimalpoint') . Just . head) parts
|
let (intparts',fracparts') = span ((/= decimalpoint') . Just . head) parts
|
||||||
(intparts, fracpart) = (filter numeric intparts', filter numeric fracparts')
|
(intparts, fracpart) = (filter numeric intparts', filter numeric fracparts')
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user