Number.hs

{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- Module      :  Data.Attoparsec.Text.Number
-- Copyright   :  Bryan O'Sullivan 2011, Bas van Dijk 2011
-- License     :  BSD3
--
-- Maintainer  :  [email protected]
-- Stability   :  experimental
-- Portability :  unknown
--
-- A simple number type, useful for parsing both exact and inexact
-- quantities without losing precision.
module Data.Attoparsec.Text.Number
    (
      Number(..)
    ) where

import Control.DeepSeq (NFData(rnf))
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Ratio ((%))

-- | A numeric type that can represent integers accurately, and
-- floating point numbers to the precision of a 'Double'.
data Number = I !Integer
            | R !Rational
              deriving (Typeable, Data)

instance Show Number where
    show (I a) = show a
    show (R a) = show a

instance NFData Number where
    rnf (I _) = ()
    rnf (R _) = ()
    {-# INLINE rnf #-}

binop :: (Integer  -> Integer  -> a) 
      -> (Rational -> Rational -> a)
      -> (Number   -> Number   -> a)
binop _ r (R a) (R b) = r a b
binop i _ (I a) (I b) = i a b
binop _ r (R a) (I b) = r a (fromIntegral b)
binop _ r (I a) (R b) = r (fromIntegral a) b
{-# INLINE binop #-}

instance Eq Number where
    (==) = binop (==) (==)
    {-# INLINE (==) #-}

    (/=) = binop (/=) (/=)
    {-# INLINE (/=) #-}

instance Ord Number where
    (<) = binop (<) (<)
    {-# INLINE (<) #-}

    (<=) = binop (<=) (<=)
    {-# INLINE (<=) #-}

    (>) = binop (>) (>)
    {-# INLINE (>) #-}

    (>=) = binop (>=) (>=)
    {-# INLINE (>=) #-}

    compare = binop compare compare
    {-# INLINE compare #-}

instance Num Number where
    (+) = binop (((I$!).) . (+)) (((R$!).) . (+))
    {-# INLINE (+) #-}

    (-) = binop (((I$!).) . (-)) (((R$!).) . (-))
    {-# INLINE (-) #-}

    (*) = binop (((I$!).) . (*)) (((R$!).) . (*))
    {-# INLINE (*) #-}

    abs (I a) = I $! abs a
    abs (R a) = R $! abs a
    {-# INLINE abs #-}

    negate (I a) = I $! negate a
    negate (R a) = R $! negate a
    {-# INLINE negate #-}

    signum (I a) = I $! signum a
    signum (R a) = R $! signum a
    {-# INLINE signum #-}

    fromInteger = (I$!) . fromInteger
    {-# INLINE fromInteger #-}

instance Real Number where
    toRational (I a) = fromIntegral a
    toRational (R a) = a
    {-# INLINE toRational #-}

instance Fractional Number where
    fromRational = (R$!)
    {-# INLINE fromRational #-}

    (/) = binop (((R$!).) . (%))
                (((R$!).) . (/))
    {-# INLINE (/) #-}

    recip (I a) = R $! recip (fromIntegral a)
    recip (R a) = R $! recip a
    {-# INLINE recip #-}

instance RealFrac Number where
    properFraction (I a) = (fromIntegral a,0)
    properFraction (R a) = case properFraction a of
                             (i,d) -> (i,R d)
    {-# INLINE properFraction #-}
    truncate (I a) = fromIntegral a
    truncate (R a) = truncate a
    {-# INLINE truncate #-}
    round (I a) = fromIntegral a
    round (R a) = round a
    {-# INLINE round #-}
    ceiling (I a) = fromIntegral a
    ceiling (R a) = ceiling a
    {-# INLINE ceiling #-}
    floor (I a) = fromIntegral a
    floor (R a) = floor a
    {-# INLINE floor #-}