module Data.ByteString.Read
(
floating
, double
, signed
, EffectiveDigit(..)
, Base(..)
, floating10
, floating'
) where
import Control.Arrow(first)
import Control.Applicative((<$>))
import Data.ByteString.Unsafe
import Data.ByteString(ByteString)
import qualified Data.ByteString as S
import Data.Word
import GHC.TypeLits.Compat
import Data.Proxy.Compat
minus :: Word8
minus = 45
plus :: Word8
plus = 43
class (Fractional a, Num (Fraction a), Ord (Fraction a)) => EffectiveDigit a where
data Fraction a
maxValue :: proxy a -> Maybe (Fraction a)
fromFraction :: Num b => Fraction a -> b
instance EffectiveDigit Float where
newtype Fraction Float = FractionFloat Word32
deriving(Eq, Ord, Num)
maxValue _ = let t = 0 :: Float in Just $ fromIntegral (floatRadix t) ^ floatDigits t
fromFraction (FractionFloat a) = fromIntegral a
instance EffectiveDigit Double where
newtype Fraction Double = FractionDouble Word64
deriving(Eq, Ord, Num)
maxValue _ = let t = 0 :: Double in Just $ fromIntegral (floatRadix t) ^ floatDigits t
fromFraction (FractionDouble a) = fromIntegral a
instance EffectiveDigit Rational where
newtype Fraction Rational = WordRational Integer
deriving(Eq, Ord, Num)
maxValue _ = Nothing
fromFraction (WordRational a) = fromIntegral a
class KnownNat n => Base n where
isDigit :: proxy n -> Word8 -> Bool
unsafeToDigit :: proxy n -> Word8 -> Word8
#define defineBaseUnder10(BASE, MAX)\
instance Base BASE where;\
;\
;\
isDigit _ = \w -> 48 <= w && w <= MAX;\
unsafeToDigit _ w = w 48
defineBaseUnder10( 2, 49)
defineBaseUnder10( 3, 50)
defineBaseUnder10( 4, 51)
defineBaseUnder10( 5, 52)
defineBaseUnder10( 6, 53)
defineBaseUnder10( 7, 54)
defineBaseUnder10( 8, 55)
defineBaseUnder10( 9, 56)
defineBaseUnder10(10, 57)
#define defineBaseOver10(BASE, MAXu, MAXl)\
instance Base BASE where;\
;\
;\
isDigit _ = \w -> 48 <= w && w <= 57 || 65 <= w && w <= MAXu || 97 <= w && w <= MAXl;\
unsafeToDigit _ w = if 48 <= w && w <= 57;\
then fromIntegral w 48;\
else if 65 <= w && w <= 90;\
then fromIntegral w 55;\
else fromIntegral w 87
defineBaseOver10(11, 65, 97)
defineBaseOver10(12, 66, 98)
defineBaseOver10(13, 67, 99)
defineBaseOver10(14, 68, 100)
defineBaseOver10(15, 69, 101)
defineBaseOver10(16, 70, 102)
defineBaseOver10(17, 71, 103)
defineBaseOver10(18, 72, 104)
defineBaseOver10(19, 73, 105)
defineBaseOver10(20, 74, 106)
defineBaseOver10(21, 75, 107)
defineBaseOver10(22, 76, 108)
defineBaseOver10(23, 77, 109)
defineBaseOver10(24, 78, 110)
defineBaseOver10(25, 79, 111)
defineBaseOver10(26, 80, 112)
defineBaseOver10(27, 81, 113)
defineBaseOver10(28, 82, 114)
defineBaseOver10(29, 83, 115)
defineBaseOver10(30, 84, 116)
defineBaseOver10(31, 85, 117)
defineBaseOver10(32, 86, 118)
defineBaseOver10(33, 87, 119)
defineBaseOver10(34, 88, 120)
defineBaseOver10(35, 89, 121)
defineBaseOver10(36, 90, 122)
integral :: forall proxy n r. (Base n, EffectiveDigit r, Ord (Fraction r), Num (Fraction r))
=> proxy n -> ByteString -> (Fraction r, Int, Int, ByteString)
integral pn = loop 0 0 0
where
pr :: Proxy r
pr = Proxy
loop !i !d !ad !s
| S.null s = (i, d, ad, s)
| not (isDigit pn (unsafeHead s)) = (i, d, ad, s)
| maybe False (i >=) (maxValue pr) = loop i d (ad + 1) (unsafeTail s)
| otherwise = loop
(i * fromIntegral (natVal pn) + (fromIntegral $ unsafeToDigit pn (unsafeHead s) :: Fraction r))
(d+1) ad (unsafeTail s)
toFractional :: (Base b, EffectiveDigit r, Fractional r)
=> proxy b -> Fraction r -> Fraction r -> Int -> Int -> r
toFractional p q r du d = fromFraction q * base ^ du + fromFraction r / base ^ d
where
base = fromIntegral (natVal p)
floating' :: (Base b, EffectiveDigit r) => proxy b -> ByteString -> Maybe (r, ByteString)
floating' pn s = case integral pn s of
(_, 0, _, _) -> Nothing
(q, _, d, "") -> Just (fromFraction q * fromIntegral (natVal pn) ^ d, "")
(q, _, d, s1)
| unsafeHead s1 /= dot -> Just (fromFraction q, s1)
| otherwise -> case integral pn (unsafeTail s1) of
(_, 0, _, _) -> Just (fromFraction q, s1)
(r, d', _, s2) -> Just (toFractional pn q r d d', s2)
where
dot = 46
exponential :: forall proxy r. (EffectiveDigit r, Ord (Fraction r), Num (Fraction r))
=> proxy r -> ByteString -> (Int, ByteString)
exponential _ s0
| S.null s0 = (0, s0)
| isE (unsafeHead s0) = sign (unsafeTail s0)
| otherwise = (0, s0)
where
isE w = w == 101 || w == 69
sign s1
| S.null s1 = (0, s0)
| unsafeHead s1 == plus = expPart $ unsafeTail s1
| unsafeHead s1 == minus = let (e, s) = expPart $ unsafeTail s1 in (e, s)
| otherwise = expPart s1
expPart s2 = case integral (Proxy :: Proxy 10) s2 :: (Fraction r, Int, Int, ByteString) of
(_, 0, _, _) -> (0, s0)
(e, _, _, s) -> (fromFraction e, s)
setExpPart :: Fractional f => Int -> f -> f
setExpPart e f
| e >= 0 = f * 10 ^ e
| otherwise = f / 10 ^ abs e
floating10 :: forall r. EffectiveDigit r => ByteString -> Maybe (r, ByteString)
floating10 s = floating' (Proxy :: Proxy 10) s >>= \(f, s') ->
let (e, s'') = exponential (Proxy :: Proxy r) s'
in Just (setExpPart e f, s'')
floating :: EffectiveDigit r => ByteString -> Maybe (r, ByteString)
floating s0
| S.null s0 = Nothing
| unsafeHead s0 == zero = base $ unsafeTail s0
| otherwise = floating10 s0
where
zero = 48
isX w = w == 120 || w == 88
isO w = w == 111 || w == 79
base s1
| S.null s1 = Just (0, "")
| isX (unsafeHead s1) = floating' (Proxy :: Proxy 16) (unsafeTail s1)
| isO (unsafeHead s1) = floating' (Proxy :: Proxy 8) (unsafeTail s1)
| otherwise = floating10 s0
double :: ByteString -> Maybe (Double, ByteString)
double = floating
signed :: Num r => (ByteString -> Maybe (r, ByteString)) -> ByteString -> Maybe (r, ByteString)
signed f s
| S.null s = Nothing
| unsafeHead s == minus = first negate <$> f (unsafeTail s)
| unsafeHead s == plus = f (unsafeTail s)
| otherwise = f s