decimal-arithmetic-0.1.0.0: src/Numeric/Decimal/Conversion.hs
-- | The functions in this module implement conversions between 'Number' and
-- 'String' as described in the /General Decimal Arithmetic Specification/.
--
-- Because these functions are also used to implement 'Show' and 'Read' class
-- methods, it is not usually necessary to import this module except to use
-- the 'toEngineeringString' function.
module Numeric.Decimal.Conversion
( -- * Numeric string syntax
-- $numeric-string-syntax
-- * Conversion to numeric string
toScientificString
, toEngineeringString
-- * Conversion from numeric string
, toNumber
) where
import Prelude hiding (exponent, round)
import Control.Applicative ((<|>))
import Data.Char (isDigit, digitToInt, toLower, toUpper)
import Data.List (foldl')
import Text.ParserCombinators.ReadP (ReadP, char, many, many1, option, optional,
satisfy)
import Numeric.Decimal.Number
import Numeric.Decimal.Precision
import Numeric.Decimal.Rounding
-- | Convert a number to a string, using scientific notation if an exponent is
-- needed.
toScientificString :: Number p r -> ShowS
toScientificString = showNumber exponential
where exponential :: Exponent -> String -> Exponent -> ShowS
exponential e (d1:ds@(_:_)) _ = showChar d1 . showChar '.' .
showString ds . showExponent e
exponential e ds _ = showString ds . showExponent e
-- | Convert a number to a string, using engineering notation if an exponent
-- is needed.
toEngineeringString :: Number p r -> ShowS
toEngineeringString = showNumber exponential
where exponential :: Exponent -> String -> Exponent -> ShowS
exponential e ds@"0" _ = showString ds' . showExponent (e + adj)
where adj = (3 - e `mod` 3) `mod` 3
ds' | adj > 0 = '0' : '.' : replicate (fromIntegral adj) '0'
| otherwise = ds
exponential e ds cl = shift adj (e - adj) ds'
where adj = e `mod` 3
ds' | cl - 1 < adj = ds ++
replicate (fromIntegral (adj - cl + 1)) '0'
| otherwise = ds
shift :: Exponent -> Exponent -> String -> ShowS
shift 2 e (d1:d2:d3:ds@(_:_)) = showChar d1 . showChar d2 .
showChar d3 . showChar '.' .
showString ds . showExponent e
shift 1 e (d1:d2:ds@(_:_)) = showChar d1 . showChar d2 .
showChar '.' .
showString ds . showExponent e
shift 0 e (d1:ds@(_:_)) = showChar d1 . showChar '.' .
showString ds . showExponent e
shift _ e ds = showString ds . showExponent e
showNumber :: (Exponent -> String -> Exponent -> ShowS)
-> Number p r -> ShowS
showNumber exponential num = signStr . case num of
Num { coefficient = c, exponent = e }
| e <= 0 && ae >= -6 -> nonExponential
| otherwise -> exponential ae cs cl
where cs = show c :: String
cl = fromIntegral (length cs) :: Exponent
ae = e + cl - 1 :: Exponent
nonExponential :: ShowS
nonExponential
| e == 0 = showString cs
| -e < cl = let (ca, cb) = splitAt (fromIntegral $ cl + e) cs
in showString ca . showChar '.' . showString cb
| otherwise = showChar '0' . showChar '.' .
showString (replicate (fromIntegral $ -e - cl) '0') .
showString cs
Inf { } -> showString "Infinity"
QNaN { payload = p } -> showString "NaN" . diag p
SNaN { payload = p } -> showString "sNaN" . diag p
where signStr :: ShowS
signStr = showString $ case sign num of
Pos -> ""
Neg -> "-"
diag :: Payload -> ShowS
diag 0 = showString ""
diag d = shows d
showExponent :: Exponent -> ShowS
showExponent e
| e == 0 = id -- do not show zero exponent
| e < 0 = indicator . exps
| otherwise = indicator . showChar '+' . exps
where indicator = showChar 'E' :: ShowS
exps = shows e :: ShowS
-- | Convert a string to a number, as defined by its abstract representation.
-- The string is expected to conform to the numeric string syntax described
-- here.
toNumber :: (Precision p, Rounding r) => ReadP (Number p r)
toNumber = round <$> (parseSign flipSign <*> parseNumericString)
where parseSign :: (a -> a) -> ReadP (a -> a)
parseSign negate = char '-' *> pure negate
<|> optional (char '+') *> pure id
parseNumericString :: ReadP (Number p r)
parseNumericString = parseNumericValue <|> parseNaN
parseNumericValue :: ReadP (Number p r)
parseNumericValue = parseDecimalPart <*> option 0 parseExponentPart
<|> parseInfinity
parseDecimalPart :: ReadP (Exponent -> Number p r)
parseDecimalPart = digitsWithPoint <|> digitsWithOptionalPoint
where digitsWithPoint = do
digits <- many1 parseDigit
char '.'
fracDigits <- many parseDigit
return $ \e ->
Num { context = defaultContext
, sign = Pos
, coefficient = readDigits (digits ++ fracDigits)
, exponent = e - fromIntegral (length fracDigits)
}
digitsWithOptionalPoint = fractionalDigits <|> wholeDigits
fractionalDigits = do
char '.'
fracDigits <- many1 parseDigit
return $ \e ->
Num { context = defaultContext
, sign = Pos
, coefficient = readDigits fracDigits
, exponent = e - fromIntegral (length fracDigits)
}
wholeDigits = do
digits <- many1 parseDigit
return $ \e -> Num { context = defaultContext
, sign = Pos
, coefficient = readDigits digits
, exponent = e
}
parseExponentPart :: ReadP Exponent
parseExponentPart = do
parseString "E"
parseSign negate <*> (readDigits <$> many1 parseDigit)
parseInfinity :: ReadP (Number p r)
parseInfinity = do
parseString "Inf"
optional $ parseString "inity"
return Inf { context = defaultContext, sign = Pos }
parseNaN :: ReadP (Number p r)
parseNaN = parseQNaN <|> parseSNaN
parseQNaN :: ReadP (Number p r)
parseQNaN = do
p <- parseNaNPayload
return QNaN { context = defaultContext, sign = Pos, payload = p }
parseSNaN :: ReadP (Number p r)
parseSNaN = do
parseString "s"
p <- parseNaNPayload
return SNaN { context = defaultContext, sign = Pos, payload = p }
parseNaNPayload :: ReadP Payload
parseNaNPayload = do
parseString "NaN"
readDigits <$> many parseDigit
parseDigit :: ReadP Int
parseDigit = digitToInt <$> satisfy isDigit
parseString :: String -> ReadP ()
parseString = mapM_ $ \c -> char (toLower c) <|> char (toUpper c)
readDigits :: Num c => [Int] -> c
readDigits = foldl' (\a b -> a * 10 + fromIntegral b) 0
-- $numeric-string-syntax
--
-- (The following description is from the
-- /General Decimal Arithmetic Specification/.)
--
-- Strings which are acceptable for conversion to the abstract representation
-- of numbers, or which might result from conversion from the abstract
-- representation to a string, are called /numeric strings/.
--
-- A /numeric string/ is a character string that describes either a /finite number/ or a /special value/.
--
-- * If it describes a /finite number/, it includes one or more decimal
-- digits, with an optional decimal point. The decimal point may be embedded
-- in the digits, or may be prefixed or suffixed to them. The group of
-- digits (and optional point) thus constructed may have an optional sign
-- (“@+@” or “@-@”) which must come before any digits or decimal point.
--
-- The string thus described may optionally be followed by an “@E@”
-- (indicating an exponential part), an optional sign, and an integer
-- following the sign that represents a power of ten that is to be
-- applied. The “@E@” may be in uppercase or lowercase.
--
-- * If it describes a /special value/, it is one of the case-independent
-- names “@Infinity@”, “@Inf@”, “@NaN@”, or “@sNaN@” (where the first two
-- represent /infinity/ and the second two represent /quiet NaN/ and
-- /signaling NaN/ respectively). The name may be preceded by an optional
-- sign, as for finite numbers. If a NaN, the name may also be followed by
-- one or more digits, which encode any diagnostic information.
--
-- No blanks or other white space characters are permitted in a numeric string.
--
-- == Examples
--
-- Some numeric strings are:
--
-- > "0" -- zero
-- > "12" -- a whole number
-- > "-76" -- a signed whole number
-- > "12.70" -- some decimal places
-- > "+0.003" -- a plus sign is allowed, too
-- > "017." -- the same as 17
-- > ".5" -- the same as 0.5
-- > "4E+9" -- exponential notation
-- > "0.73e-7" -- exponential notation, negative power
-- > "Inf" -- the same as Infinity
-- > "-infinity" -- the same as -Inf
-- > "NaN" -- not-a-Number
-- > "NaN8275" -- diagnostic NaN
--
-- == Notes
--
-- 1. A single period alone or with a sign is not a valid numeric string.
-- 2. A sign alone is not a valid numeric string.
-- 3. Significant (after the decimal point) and insignificant leading zeros are permitted.