-- | 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.