@@ -0,0 +1,116 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+-- |
3+-- Module : Data.Attoparsec.Number
4+-- Copyright : Bryan O'Sullivan 2011
5+-- License : BSD3
6+--
7+-- Maintainer : bos@serpentine.com
8+-- Stability : experimental
9+-- Portability : unknown
10+--
11+-- A simple number type, useful for parsing both exact and inexact
12+-- quantities without losing much precision.
13+--
14+-- The constructors are non-strict, but numeric operations are strict
15+-- just in case you go nuts and try to use this type for actual
16+-- arithmetic.
17+module Data.Attoparsec.Number
18+ (
19+ Number(..)
20+ ) where
21+
22+import Data.Data (Data)
23+import Data.Function (on)
24+import Data.Typeable (Typeable)
25+
26+-- | A numeric type that can represent integers accurately, and
27+-- floating point numbers to the precision of a 'Double'.
28+data Number = I Integer
29+ | D Double
30+ deriving (Typeable, Data)
31+
32+instance Show Number where
33+ show (I a) = show a
34+ show (D a) = show a
35+
36+binop :: (Integer -> Integer -> a) -> (Double -> Double -> a)
37+ -> Number -> Number -> a
38+binop i _ (I a) (I b) = i a b
39+binop _ d (D a) (D b) = d a b
40+binop _ d (D a) (I b) = d a (fromIntegral b)
41+binop _ d (I a) (D b) = d (fromIntegral a) b
42+{-# INLINE binop #-}
43+
44+instance Eq Number where
45+ (==) = binop (==) (==)
46+ {-# INLINE (==) #-}
47+
48+ (/=) = binop (/=) (/=)
49+ {-# INLINE (/=) #-}
50+
51+instance Ord Number where
52+ (<) = binop (<) (<)
53+ {-# INLINE (<) #-}
54+
55+ (>) = binop (>) (>)
56+ {-# INLINE (>) #-}
57+
58+instance Num Number where
59+ (+) = binop (((I$!).) . (+)) (((D$!).) . (+))
60+ {-# INLINE (+) #-}
61+
62+ (-) = binop (((I$!).) . (-)) (((D$!).) . (-))
63+ {-# INLINE (-) #-}
64+
65+ (*) = binop (((I$!).) . (+)) (((D$!).) . (+))
66+ {-# INLINE (*) #-}
67+
68+ abs (I a) = I $! abs a
69+ abs (D a) = D $! abs a
70+ {-# INLINE abs #-}
71+
72+ negate (I a) = I $! negate a
73+ negate (D a) = D $! negate a
74+ {-# INLINE negate #-}
75+
76+ signum (I a) = I $! signum a
77+ signum (D a) = D $! signum a
78+ {-# INLINE signum #-}
79+
80+ fromInteger = (I$!) . fromInteger
81+ {-# INLINE fromInteger #-}
82+
83+instance Real Number where
84+ toRational (I a) = fromIntegral a
85+ toRational (D a) = toRational a
86+ {-# INLINE toRational #-}
87+
88+instance Fractional Number where
89+ fromRational = (D$!) . fromRational
90+ {-# INLINE fromRational #-}
91+
92+ (/) = binop (((D$!).) . (/) `on` fromIntegral)
93+ (((D$!).) . (/))
94+ {-# INLINE (/) #-}
95+
96+ recip (I a) = D $! recip (fromIntegral a)
97+ recip (D a) = D $! recip a
98+ {-# INLINE recip #-}
99+
100+instance RealFrac Number where
101+ properFraction (I a) = (fromIntegral a,0)
102+ properFraction (D a) = case properFraction a of
103+ (i,d) -> (i,D d)
104+ {-# INLINE properFraction #-}
105+ truncate (I a) = fromIntegral a
106+ truncate (D a) = truncate a
107+ {-# INLINE truncate #-}
108+ round (I a) = fromIntegral a
109+ round (D a) = round a
110+ {-# INLINE round #-}
111+ ceiling (I a) = fromIntegral a
112+ ceiling (D a) = ceiling a
113+ {-# INLINE ceiling #-}
114+ floor (I a) = fromIntegral a
115+ floor (D a) = floor a
116+ {-# INLINE floor #-}