diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
SOFTWARE = polyparse
-VERSION = 1.2
+VERSION = 1.3
CPP = cpp -traditional
#CPP = cpphs --text # useful e.g. on MacOS X
diff --git a/docs/changelog.html b/docs/changelog.html
--- a/docs/changelog.html
+++ b/docs/changelog.html
@@ -16,6 +16,13 @@
Changes in polyparse-1.2
+- Bugfix: Text.Parse.parseFloat now accepts ordinary floating point
+ notation, in addition to scientific (exponent) notation.
+
+
+Changes in polyparse-1.2
+
+
- Improves the Text.Parse implementation significantly. Where
previously all the parsers for builtin basic datatype (Int,Float,Char)
were just thin wrappers over the H'98 Read instances, now they are all
diff --git a/docs/haddock/src/Text/Parse.html b/docs/haddock/src/Text/Parse.html
--- a/docs/haddock/src/Text/Parse.html
+++ b/docs/haddock/src/Text/Parse.html
@@ -179,207 +179,209 @@
parseHex = parseInt "hex" 16 Char.isHexDigit Char.digitToInt
parseFloat :: (RealFrac a) => TextParser a
-parseFloat = do ds <- many1 (satisfy isDigit)
+parseFloat = do ds <- many1 (satisfy isDigit)
frac <- (do '.' <- next
many (satisfy isDigit)
`adjustErrBad` (++"expected digit after .")
`onFail` return [] )
- exp <- (do 'e' <- fmap toLower next
- commit (do '+' <- next; parseDec 0
- `onFail`
- parseSigned (parseDec 0) ))
- ( return . fromRational . (* (10^^(exp - length frac)))
- . (%1) . (\ (Right x)->x) . fst
- . runParser (parseDec 0) ) (ds++frac)
- `onFail`
- do w <- many (satisfy (not.isSpace))
- case map toLower w of
- "nan" -> return (0/0)
- "infinity" -> return (1/0)
- _ -> fail "expected a floating point number"
-
-parseLitChar :: TextParser Char
-parseLitChar = do '\'' <- next `adjustErr` (++"expected a literal char")
- c <- next
- char <- case c of
- '\\' -> next >>= escape
- '\'' -> fail "expected a literal char, got ''"
- _ -> return c
- '\'' <- next `adjustErrBad` (++"literal char has no final '")
- return char
- where
- escape 'a' = return '\a'
- escape 'b' = return '\b'
- escape 'f' = return '\f'
- escape 'n' = return '\n'
- escape 'r' = return '\r'
- escape 't' = return '\t'
- escape 'v' = return '\v'
- escape '\\' = return '\\'
- escape '"' = return '"'
- escape '\'' = return '\''
- escape '^' = do ctrl <- next
- if ctrl >= '@' && ctrl <= '_'
- then return (chr (ord ctrl - ord '@'))
- else fail ("literal char ctrl-escape malformed: \\^"
- ++[ctrl])
- escape d | isDigit d
- = fmap chr $ parseDec (Char.digitToInt d)
- escape 'o' = fmap chr $ parseOct 0
- escape 'x' = fmap chr $ parseHex 0
- escape c | isUpper c
- = mnemonic c
- escape c = fail ("unrecognised escape sequence in literal char: \\"++[c])
-
- mnemonic 'A' = do 'C' <- next; 'K' <- next; return '\ACK'
- `wrap` "'\\ACK'"
- mnemonic 'B' = do 'E' <- next; 'L' <- next; return '\BEL'
- `onFail`
- do 'S' <- next; return '\BS'
- `wrap` "'\\BEL' or '\\BS'"
- mnemonic 'C' = do 'R' <- next; return '\CR'
- `onFail`
- do 'A' <- next; 'N' <- next; return '\CAN'
- `wrap` "'\\CR' or '\\CAN'"
- mnemonic 'D' = do 'E' <- next; 'L' <- next; return '\DEL'
- `onFail`
- do 'L' <- next; 'E' <- next; return '\DLE'
+ exp <- if null frac then exponent
+ else exponent `onFail` return 0
+ ( return . fromRational . (* (10^^(exp - length frac)))
+ . (%1) . (\ (Right x)->x) . fst
+ . runParser (parseDec 0) ) (ds++frac)
+ `onFail`
+ do w <- many (satisfy (not.isSpace))
+ case map toLower w of
+ "nan" -> return (0/0)
+ "infinity" -> return (1/0)
+ _ -> fail "expected a floating point number"
+ where exponent = do 'e' <- fmap toLower next
+ commit (do '+' <- next; parseDec 0
+ `onFail`
+ parseSigned (parseDec 0) )
+
+parseLitChar :: TextParser Char
+parseLitChar = do '\'' <- next `adjustErr` (++"expected a literal char")
+ c <- next
+ char <- case c of
+ '\\' -> next >>= escape
+ '\'' -> fail "expected a literal char, got ''"
+ _ -> return c
+ '\'' <- next `adjustErrBad` (++"literal char has no final '")
+ return char
+ where
+ escape 'a' = return '\a'
+ escape 'b' = return '\b'
+ escape 'f' = return '\f'
+ escape 'n' = return '\n'
+ escape 'r' = return '\r'
+ escape 't' = return '\t'
+ escape 'v' = return '\v'
+ escape '\\' = return '\\'
+ escape '"' = return '"'
+ escape '\'' = return '\''
+ escape '^' = do ctrl <- next
+ if ctrl >= '@' && ctrl <= '_'
+ then return (chr (ord ctrl - ord '@'))
+ else fail ("literal char ctrl-escape malformed: \\^"
+ ++[ctrl])
+ escape d | isDigit d
+ = fmap chr $ parseDec (Char.digitToInt d)
+ escape 'o' = fmap chr $ parseOct 0
+ escape 'x' = fmap chr $ parseHex 0
+ escape c | isUpper c
+ = mnemonic c
+ escape c = fail ("unrecognised escape sequence in literal char: \\"++[c])
+
+ mnemonic 'A' = do 'C' <- next; 'K' <- next; return '\ACK'
+ `wrap` "'\\ACK'"
+ mnemonic 'B' = do 'E' <- next; 'L' <- next; return '\BEL'
+ `onFail`
+ do 'S' <- next; return '\BS'
+ `wrap` "'\\BEL' or '\\BS'"
+ mnemonic 'C' = do 'R' <- next; return '\CR'
+ `onFail`
+ do 'A' <- next; 'N' <- next; return '\CAN'
+ `wrap` "'\\CR' or '\\CAN'"
+ mnemonic 'D' = do 'E' <- next; 'L' <- next; return '\DEL'
`onFail`
- do 'C' <- next; ( do '1' <- next; return '\DC1'
- `onFail`
- do '2' <- next; return '\DC2'
+ do 'L' <- next; 'E' <- next; return '\DLE'
+ `onFail`
+ do 'C' <- next; ( do '1' <- next; return '\DC1'
`onFail`
- do '3' <- next; return '\DC3'
+ do '2' <- next; return '\DC2'
`onFail`
- do '4' <- next; return '\DC4' )
- `wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'"
- mnemonic 'E' = do 'T' <- next; 'X' <- next; return '\ETX'
- `onFail`
- do 'O' <- next; 'T' <- next; return '\EOT'
+ do '3' <- next; return '\DC3'
+ `onFail`
+ do '4' <- next; return '\DC4' )
+ `wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'"
+ mnemonic 'E' = do 'T' <- next; 'X' <- next; return '\ETX'
`onFail`
- do 'N' <- next; 'Q' <- next; return '\ENQ'
+ do 'O' <- next; 'T' <- next; return '\EOT'
`onFail`
- do 'T' <- next; 'B' <- next; return '\ETB'
+ do 'N' <- next; 'Q' <- next; return '\ENQ'
`onFail`
- do 'M' <- next; return '\EM'
+ do 'T' <- next; 'B' <- next; return '\ETB'
`onFail`
- do 'S' <- next; 'C' <- next; return '\ESC'
- `wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
- mnemonic 'F' = do 'F' <- next; return '\FF'
- `onFail`
- do 'S' <- next; return '\FS'
- `wrap` "'\\FF' or '\\FS'"
- mnemonic 'G' = do 'S' <- next; return '\GS'
- `wrap` "'\\GS'"
- mnemonic 'H' = do 'T' <- next; return '\HT'
- `wrap` "'\\HT'"
- mnemonic 'L' = do 'F' <- next; return '\LF'
- `wrap` "'\\LF'"
- mnemonic 'N' = do 'U' <- next; 'L' <- next; return '\NUL'
- `onFail`
- do 'A' <- next; 'K' <- next; return '\NAK'
- `wrap` "'\\NUL' or '\\NAK'"
- mnemonic 'R' = do 'S' <- next; return '\RS'
- `wrap` "'\\RS'"
- mnemonic 'S' = do 'O' <- next; 'H' <- next; return '\SOH'
- `onFail`
- do 'O' <- next; return '\SO'
+ do 'M' <- next; return '\EM'
+ `onFail`
+ do 'S' <- next; 'C' <- next; return '\ESC'
+ `wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
+ mnemonic 'F' = do 'F' <- next; return '\FF'
+ `onFail`
+ do 'S' <- next; return '\FS'
+ `wrap` "'\\FF' or '\\FS'"
+ mnemonic 'G' = do 'S' <- next; return '\GS'
+ `wrap` "'\\GS'"
+ mnemonic 'H' = do 'T' <- next; return '\HT'
+ `wrap` "'\\HT'"
+ mnemonic 'L' = do 'F' <- next; return '\LF'
+ `wrap` "'\\LF'"
+ mnemonic 'N' = do 'U' <- next; 'L' <- next; return '\NUL'
+ `onFail`
+ do 'A' <- next; 'K' <- next; return '\NAK'
+ `wrap` "'\\NUL' or '\\NAK'"
+ mnemonic 'R' = do 'S' <- next; return '\RS'
+ `wrap` "'\\RS'"
+ mnemonic 'S' = do 'O' <- next; 'H' <- next; return '\SOH'
`onFail`
- do 'T' <- next; 'X' <- next; return '\STX'
+ do 'O' <- next; return '\SO'
`onFail`
- do 'I' <- next; return '\SI'
+ do 'T' <- next; 'X' <- next; return '\STX'
`onFail`
- do 'Y' <- next; 'N' <- next; return '\SYN'
+ do 'I' <- next; return '\SI'
`onFail`
- do 'U' <- next; 'B' <- next; return '\SUB'
+ do 'Y' <- next; 'N' <- next; return '\SYN'
`onFail`
- do 'P' <- next; return '\SP'
- `wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
- mnemonic 'U' = do 'S' <- next; return '\US'
- `wrap` "'\\US'"
- mnemonic 'V' = do 'T' <- next; return '\VT'
- `wrap` "'\\VT'"
- wrap p s = p `onFail` fail ("expected literal char "++s)
-
--- Basic types
-instance Parse Int where
- -- parse = parseByRead "Int" -- convert from Integer, deals with minInt
- parse = fmap fromInteger $
- do many (satisfy isSpace); parseSigned (parseDec 0)
-instance Parse Integer where
- -- parse = parseByRead "Integer"
- parse = do many (satisfy isSpace); parseSigned (parseDec 0)
-instance Parse Float where
- -- parse = parseByRead "Float"
- parse = do many (satisfy isSpace); parseSigned parseFloat
-instance Parse Double where
- -- parse = parseByRead "Double"
- parse = do many (satisfy isSpace); parseSigned parseFloat
-instance Parse Char where
--- parse = parseByRead "Char"
- parse = do many (satisfy isSpace); parseLitChar
- -- parse = do { w <- word; if head w == '\'' then readLitChar (tail w)
- -- else fail "expected a char" }
- -- parseList = bracket (isWord "\"") (satisfy (=='"'))
- -- (many (satisfy (/='"')))
- -- not totally correct for strings...
- parseList = do { w <- word; if head w == '"' then return (init (tail w))
- else fail "not a string" }
-
-instance Parse Bool where
- parse = enumeration "Bool" [False,True]
-
-instance Parse Ordering where
- parse = enumeration "Ordering" [LT,EQ,GT]
-
--- Structural types
-instance Parse () where
- parse = P p
- where p [] = Failure [] "no input: expected a ()"
- p ('(':cs) = case dropWhile isSpace cs of
- (')':s) -> Success s ()
- _ -> Failure cs "Expected ) after ("
- p (c:cs) | isSpace c = p cs
- | otherwise = Failure (c:cs) ("Expected a (), got "++show c)
-
-instance (Parse a, Parse b) => Parse (a,b) where
- parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
- ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++)
- ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++)
- ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++)
- ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++)
- ; return (x,y) }
-
-instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
- parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++)
- ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++)
- ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++)
- ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++)
- ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++)
- ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++)
- ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++)
- ; return (x,y,z) }
-
-instance Parse a => Parse (Maybe a) where
- parsePrec p =
- parens False (do { isWord "Nothing"; return Nothing })
- `onFail`
- parens (p>9) (do { isWord "Just"
- ; fmap Just $ parsePrec 10
- `adjustErrBad` ("but within Just, "++) })
- `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
-
-instance (Parse a, Parse b) => Parse (Either a b) where
- parsePrec p =
- parens (p>9) $
- constructors [ ("Left", do { fmap Left $ parsePrec 10 } )
- , ("Right", do { fmap Right $ parsePrec 10 } )
- ]
-
-instance Parse a => Parse [a] where
- parse = parseList
-
-------------------------------------------------------------------------
+ do 'U' <- next; 'B' <- next; return '\SUB'
+ `onFail`
+ do 'P' <- next; return '\SP'
+ `wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
+ mnemonic 'U' = do 'S' <- next; return '\US'
+ `wrap` "'\\US'"
+ mnemonic 'V' = do 'T' <- next; return '\VT'
+ `wrap` "'\\VT'"
+ wrap p s = p `onFail` fail ("expected literal char "++s)
+
+-- Basic types
+instance Parse Int where
+ -- parse = parseByRead "Int" -- convert from Integer, deals with minInt
+ parse = fmap fromInteger $
+ do many (satisfy isSpace); parseSigned (parseDec 0)
+instance Parse Integer where
+ -- parse = parseByRead "Integer"
+ parse = do many (satisfy isSpace); parseSigned (parseDec 0)
+instance Parse Float where
+ -- parse = parseByRead "Float"
+ parse = do many (satisfy isSpace); parseSigned parseFloat
+instance Parse Double where
+ -- parse = parseByRead "Double"
+ parse = do many (satisfy isSpace); parseSigned parseFloat
+instance Parse Char where
+-- parse = parseByRead "Char"
+ parse = do many (satisfy isSpace); parseLitChar
+ -- parse = do { w <- word; if head w == '\'' then readLitChar (tail w)
+ -- else fail "expected a char" }
+ -- parseList = bracket (isWord "\"") (satisfy (=='"'))
+ -- (many (satisfy (/='"')))
+ -- not totally correct for strings...
+ parseList = do { w <- word; if head w == '"' then return (init (tail w))
+ else fail "not a string" }
+
+instance Parse Bool where
+ parse = enumeration "Bool" [False,True]
+
+instance Parse Ordering where
+ parse = enumeration "Ordering" [LT,EQ,GT]
+
+-- Structural types
+instance Parse () where
+ parse = P p
+ where p [] = Failure [] "no input: expected a ()"
+ p ('(':cs) = case dropWhile isSpace cs of
+ (')':s) -> Success s ()
+ _ -> Failure cs "Expected ) after ("
+ p (c:cs) | isSpace c = p cs
+ | otherwise = Failure (c:cs) ("Expected a (), got "++show c)
+
+instance (Parse a, Parse b) => Parse (a,b) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++)
+ ; return (x,y) }
+
+instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++)
+ ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++)
+ ; return (x,y,z) }
+
+instance Parse a => Parse (Maybe a) where
+ parsePrec p =
+ parens False (do { isWord "Nothing"; return Nothing })
+ `onFail`
+ parens (p>9) (do { isWord "Just"
+ ; fmap Just $ parsePrec 10
+ `adjustErrBad` ("but within Just, "++) })
+ `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
+
+instance (Parse a, Parse b) => Parse (Either a b) where
+ parsePrec p =
+ parens (p>9) $
+ constructors [ ("Left", do { fmap Left $ parsePrec 10 } )
+ , ("Right", do { fmap Right $ parsePrec 10 } )
+ ]
+
+instance Parse a => Parse [a] where
+ parse = parseList
+
+------------------------------------------------------------------------