Introduce a Number type, when both speed and accuracy count

Data/Attoparsec/Char8.hs

@@ -83,6 +83,8 @@ module Data.Attoparsec.Char8
     , hexadecimal
     , signed
     , double
+    , Number(..)
+    , number
     , rational
 
     -- * State observation and manipulation functions
@@ -94,6 +96,7 @@ import Control.Applicative ((*>), (<$>), (<|>))
 import Data.Attoparsec.Combinator
 import Data.Attoparsec.FastSet (charClass, memberChar)
 import Data.Attoparsec.Internal (Parser, (<?>))
+import Data.Attoparsec.Number (Number(..))
 import Data.Bits (Bits, (.|.), shiftL)
 import Data.ByteString.Internal (c2w, w2c)
 import Data.Ratio ((%))
@@ -386,7 +389,7 @@ data T = T !Integer !Int
 --
 -- >rational "3.foo" == Done 3.0 ".foo"
 -- >rational "3e"    == Done 3.0 "e"
-rational :: RealFloat a => Parser a
+rational :: Fractional a => Parser a
 {-# SPECIALIZE rational :: Parser Double #-}
 rational = floaty $ \real frac fracDenom -> fromRational $
                      real % 1 + frac % fracDenom
@@ -404,11 +407,28 @@ rational = floaty $ \real frac fracDenom -> fromRational $
 -- around the 15th decimal place.  For 0.001% of numbers, this
 -- function will lose precision at the 13th or 14th decimal place.
 double :: Parser Double
-double = floaty $ \real frac fracDenom ->
-                   fromIntegral real +
-                   fromIntegral frac / fromIntegral fracDenom
+double = floaty asDouble
 
-floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Parser a
+asDouble :: Integer -> Integer -> Integer -> Double
+asDouble real frac fracDenom =
+    fromIntegral real + fromIntegral frac / fromIntegral fracDenom
+{-# INLINE asDouble #-}
+
+-- | Parse a number, attempting to preserve both speed and precision.
+--
+-- The syntax accepted by this parser is the same as for 'rational'.
+--
+-- /Note/: This function is almost ten times faster than 'rational'.
+-- On integral inputs, it gives perfectly accurate answers, and on
+-- floating point inputs, it is slightly less accurate than
+-- 'rational'.
+number :: Parser Number
+number = floaty $ \real frac fracDenom ->
+         if frac == 0 && fracDenom == 0
+         then I real
+         else D (asDouble real frac fracDenom)
+
+floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Parser a
 {-# INLINE floaty #-}
 floaty f = do
   let minus = 45

Data/Attoparsec/Number.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-- |
+-- Module      :  Data.Attoparsec.Number
+-- Copyright   :  Bryan O'Sullivan 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  bos@serpentine.com
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- A simple number type, useful for parsing both exact and inexact
+-- quantities without losing much precision.
+--
+-- The constructors are non-strict, but numeric operations are strict
+-- just in case you go nuts and try to use this type for actual
+-- arithmetic.
+module Data.Attoparsec.Number
+    (
+      Number(..)
+    ) where
+
+import Data.Data (Data)
+import Data.Function (on)
+import Data.Typeable (Typeable)
+
+-- | A numeric type that can represent integers accurately, and
+-- floating point numbers to the precision of a 'Double'.
+data Number = I Integer
+            | D Double
+              deriving (Typeable, Data)
+
+instance Show Number where
+    show (I a) = show a
+    show (D a) = show a
+
+binop :: (Integer -> Integer -> a) -> (Double -> Double -> a)
+      -> Number -> Number -> a
+binop i _ (I a) (I b) = i a b
+binop _ d (D a) (D b) = d a b
+binop _ d (D a) (I b) = d a (fromIntegral b)
+binop _ d (I a) (D b) = d (fromIntegral a) b
+{-# INLINE binop #-}
+
+instance Eq Number where
+    (==) = binop (==) (==)
+    {-# INLINE (==) #-}
+
+    (/=) = binop (/=) (/=)
+    {-# INLINE (/=) #-}
+
+instance Ord Number where
+    (<) = binop (<) (<)
+    {-# INLINE (<) #-}
+
+    (>) = binop (>) (>)
+    {-# INLINE (>) #-}
+
+instance Num Number where
+    (+) = binop (((I$!).) . (+)) (((D$!).) . (+))
+    {-# INLINE (+) #-}
+
+    (-) = binop (((I$!).) . (-)) (((D$!).) . (-))
+    {-# INLINE (-) #-}
+
+    (*) = binop (((I$!).) . (+)) (((D$!).) . (+))
+    {-# INLINE (*) #-}
+
+    abs (I a) = I $! abs a
+    abs (D a) = D $! abs a
+    {-# INLINE abs #-}
+
+    negate (I a) = I $! negate a
+    negate (D a) = D $! negate a
+    {-# INLINE negate #-}
+
+    signum (I a) = I $! signum a
+    signum (D a) = D $! signum a
+    {-# INLINE signum #-}
+
+    fromInteger = (I$!) . fromInteger
+    {-# INLINE fromInteger #-}
+
+instance Real Number where
+    toRational (I a) = fromIntegral a
+    toRational (D a) = toRational a
+    {-# INLINE toRational #-}
+
+instance Fractional Number where
+    fromRational = (D$!) . fromRational
+    {-# INLINE fromRational #-}
+
+    (/) = binop (((D$!).) . (/) `on` fromIntegral)
+                (((D$!).) . (/))
+    {-# INLINE (/) #-}
+
+    recip (I a) = D $! recip (fromIntegral a)
+    recip (D a) = D $! recip a
+    {-# INLINE recip #-}
+
+instance RealFrac Number where
+    properFraction (I a) = (fromIntegral a,0)
+    properFraction (D a) = case properFraction a of
+                             (i,d) -> (i,D d)
+    {-# INLINE properFraction #-}
+    truncate (I a) = fromIntegral a
+    truncate (D a) = truncate a
+    {-# INLINE truncate #-}
+    round (I a) = fromIntegral a
+    round (D a) = round a
+    {-# INLINE round #-}
+    ceiling (I a) = fromIntegral a
+    ceiling (D a) = ceiling a
+    {-# INLINE ceiling #-}
+    floor (I a) = fromIntegral a
+    floor (D a) = floor a
+    {-# INLINE floor #-}

attoparsec.cabal

@@ -60,6 +60,7 @@ library
                    Data.Attoparsec.Lazy
                    Data.Attoparsec.Zepto
   other-modules:   Data.Attoparsec.Internal
+                   Data.Attoparsec.Number
   ghc-options:     -Wall
 
   if flag(developer)