```{-# LANGUAGE OverloadedStrings #-}

-- |
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- Stability   : experimental
-- Portability : GHC
--
-- Functions used frequently when reading textual data.
(
, decimal
, signed
, rational
, double
) where

import Data.Char (isDigit, isHexDigit, ord)
import Data.Ratio ((%))
import Data.Text as T

-- | Read some text.  If the read succeeds, return its value and the
-- remaining text, otherwise an error message.
type Reader a = Text -> Either String (a,Text)

-- | Read a decimal integer.  The input must begin with at least one
-- decimal digit, and is consumed until a non-digit or end of string
-- is reached.
--
-- This function does not handle leading sign characters.  If you need
-- to handle signed input, use @'signed' 'decimal'@.
--
-- /Note/: For fixed-width integer types, this function does not
-- attempt to detect overflow, so a sufficiently long input may give
-- incorrect results.  If you are worried about overflow, use
-- 'Integer' for your result type.
decimal :: Integral a => Reader a
{-# SPECIALIZE decimal :: Reader Int #-}
{-# SPECIALIZE decimal :: Reader Integer #-}
decimal txt
| T.null h  = Left "input does not start with a digit"
| otherwise = Right (T.foldl' go 0 h, t)
where (h,t)  = T.span isDigit txt
go n d = (n * 10 + fromIntegral (digitToInt d))

-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
-- until a non-hex-digit or end of string is reached.  This function
-- is case insensitive.
--
-- This function does not handle leading sign characters.  If you need
-- to handle signed input, use @'signed' 'hexadecimal'@.
--
-- /Note/: For fixed-width integer types, this function does not
-- attempt to detect overflow, so a sufficiently long input may give
-- incorrect results.  If you are worried about overflow, use
-- 'Integer' for your result type.
| h == "0x" || h == "0X" = hex t
| otherwise              = hex txt
where (h,t) = T.splitAt 2 txt

hex :: Integral a => Reader a
{-# SPECIALIZE hex :: Reader Int #-}
{-# SPECIALIZE hex :: Reader Integer #-}
hex txt
| otherwise = Right (T.foldl' go 0 h, t)
where (h,t)  = T.span isHexDigit txt
go n d = (n * 16 + fromIntegral (hexDigitToInt d))

hexDigitToInt :: Char -> Int
hexDigitToInt c
| c >= '0' && c <= '9' = ord c - ord '0'
| c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)
| otherwise            = ord c - (ord 'A' - 10)

digitToInt :: Char -> Int
digitToInt c = ord c - ord '0'

-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and
-- apply it to the result of applying the given reader.
{-# INLINE signed #-}
signed f = runP (signa (P f))

-- | Read a rational number.
--
-- This function accepts an optional leading sign character, followed
-- by at least one decimal digit.  The syntax similar to that accepted
-- by the 'read' function, with the exception that a trailing @\'.\'@
-- or @\'e\'@ /not/ followed by a number is not consumed.
--
-- Examples (with behaviour identical to 'read'):
--
-- >rational "3"     == Right (3.0, "")
-- >rational "3.1"   == Right (3.1, "")
-- >rational "3e4"   == Right (30000.0, "")
-- >rational "3.1e4" == Right (31000.0, "")
-- >rational ".3"    == Left "input does not start with a digit"
-- >rational "e3"    == Left "input does not start with a digit"
--
-- Examples of differences from 'read':
--
-- >rational "3.foo" == Right (3.0, ".foo")
-- >rational "3e"    == Right (3.0, "e")
rational :: RealFloat a => Reader a
{-# SPECIALIZE rational :: Reader Double #-}
rational = floaty \$ \real frac fracDenom -> fromRational \$
real % 1 + frac % fracDenom

-- | Read a rational number.
--
-- The syntax accepted by this function is the same as for 'rational'.
--
-- /Note/: This function is almost ten times faster than 'rational',
-- but is slightly less accurate.
--
-- The 'Double' type supports about 16 decimal places of accuracy.
-- For 94.2% of numbers, this function and 'rational' give identical
-- results, but for the remaining 5.8%, this function loses precision
-- around the 15th decimal place.  For 0.001% of numbers, this
-- function will lose precision at the 13th or 14th decimal place.
double = floaty \$ \real frac fracDenom ->
fromIntegral real +
fromIntegral frac / fromIntegral fracDenom

signa :: Num a => Parser a -> Parser a
{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}
{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}
signa p = do
sign <- perhaps '+' \$ char (\c -> c == '-' || c == '+')
if sign == '+' then p else negate `liftM` p

newtype Parser a = P {
}

return a = P \$ \t -> Right (a,t)
{-# INLINE return #-}
m >>= k  = P \$ \t -> case runP m t of
Left err     -> Left err
Right (a,t') -> runP (k a) t'
{-# INLINE (>>=) #-}
fail msg = P \$ \_ -> Left msg

perhaps :: a -> Parser a -> Parser a
perhaps def m = P \$ \t -> case runP m t of
Left _      -> Right (def,t)
r@(Right _) -> r

char :: (Char -> Bool) -> Parser Char
char p = P \$ \t -> case T.uncons t of
Just (c,t') | p c -> Right (c,t')
_                 -> Left "character does not match"

data T = T !Integer !Int

floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
{-# INLINE floaty #-}
floaty f = runP \$ do
sign <- perhaps '+' \$ char (\c -> c == '-' || c == '+')
real <- P decimal
T fraction fracDigits <- perhaps (T 0 0) \$ do
_ <- char (=='.')
digits <- P \$ \t -> Right (T.length \$ T.takeWhile isDigit t, t)
n <- P decimal
return \$ T n digits
let e c = c == 'e' || c == 'E'
power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
let n = if fracDigits == 0
then if power == 0
then fromIntegral real
else fromIntegral real * (10 ^^ power)
else if power == 0
then f real fraction (10 ^ fracDigits)
else f real fraction (10 ^ fracDigits) * (10 ^^ power)
return \$! if sign == '+'
then n
else -n
```