module Data.SciRatio.Read
(
readNumber
, readSciRational
, readSign
, readNumberP
, readSciRationalP
, readScientificP
, readDecimalP
, readIntegerP
, readUnsignedP
, readHexP
, readDecP
, readOctP
, readBinP
, isBinDigit
, isDecimalExponentSymbol
, isFractionSlash
) where
import Control.Monad (ap, mzero)
import Data.Char (isDigit, isHexDigit, isOctDigit, toLower)
import Data.SciRatio (SciRational)
import Text.ParserCombinators.ReadP (ReadP, (<++))
import Text.Read.Lex (readIntP)
import qualified Text.ParserCombinators.ReadP as P
readNumber :: Fractional a => String -> Maybe a
readNumber = runReadP readNumberP
readSciRational :: String -> Maybe SciRational
readSciRational = runReadP readSciRationalP
readSign :: Num a => Char -> Maybe a
readSign c = case c of
'+' -> Just 1
'-' -> Just (1)
'\x2212' -> Just (1)
_ -> Nothing
readNumberP :: Fractional a => ReadP a
readNumberP = readUnsignedP' <++ readRatioP readScientificP
readSciRationalP :: ReadP SciRational
readSciRationalP = readNumberP
readRatioP :: Fractional a =>
ReadP a
-> ReadP a
readRatioP p = fmap (/) p `ap` ((P.satisfy isFractionSlash >> p) <++ return 1)
readScientificP :: Fractional a => ReadP a
readScientificP = readSignedP $ do
r <- readDecimalP
e <- (P.satisfy isDecimalExponentSymbol >> readIntegerP) <++ return 0
return (r * pow10 e)
where pow10 = (10 ^^) :: Fractional a => Integer -> a
readDecimalP :: Fractional a => ReadP a
readDecimalP = readSignedP $ do
intPart <- P.munch isDigit
string <- P.look
case string of
'.' : _ -> do
_ <- P.get
fracPart <- P.munch isDigit
if length intPart + length fracPart == 0
then mzero
else return $ readInt' intPart +
readInt' fracPart / 10 ^^ length fracPart
_ ->
case intPart of
"" -> mzero
_ -> return $ readInt' intPart
where readInt' "" = 0
readInt' s = fromInteger (read s)
readIntegerP :: Num a => ReadP a
readIntegerP = readSignedP readDecP
readUnsignedP :: Num a => ReadP a
readUnsignedP = readUnsignedP' <++ readDecP
readUnsignedP' :: Num a => ReadP a
readUnsignedP' = do
_ <- P.char '0'
prefixChar <- P.get
fromInteger `fmap`
case toLower prefixChar of
'b' -> readBinP
'o' -> readOctP
'x' -> readHexP
_ -> mzero
readSignedP :: Num a => ReadP a -> ReadP a
readSignedP p = do
sign <- (<++ return 1) $ do
c <- P.get
case readSign c of
Just x -> return x
Nothing -> mzero
num <- p
return (sign * num)
readHexP :: Num a => ReadP a
readHexP = readIntP 16 isHexDigit digitToInt
where digitToInt c = case fromEnum c of
c' | c <= '9' -> c' fromEnum '0'
| c <= 'F' -> c' (fromEnum 'A' 10)
| otherwise -> c' (fromEnum 'a' 10)
readDecP :: Num a => ReadP a
readDecP = readIntP 10 isDigit digitToInt
where digitToInt c = fromEnum c fromEnum '0'
readOctP :: Num a => ReadP a
readOctP = readIntP 8 isOctDigit digitToInt
where digitToInt c = fromEnum c fromEnum '0'
readBinP :: Num a => ReadP a
readBinP = readIntP 2 isBinDigit digitToInt
where digitToInt c = fromEnum c fromEnum '0'
runReadP :: ReadP a -> String -> Maybe a
runReadP p s = case P.readP_to_S p s of
[(x, [])] -> Just x
_ -> Nothing
isBinDigit :: Char -> Bool
isBinDigit c = fromEnum '0' <= x && x <= fromEnum '1' where x = fromEnum c
isDecimalExponentSymbol :: Char -> Bool
isDecimalExponentSymbol = (`elem` "eE\x23e8")
isFractionSlash :: Char -> Bool
isFractionSlash = (`elem` "/\x002f\x2044\x2215")