diff --git a/bench/main.hs b/bench/main.hs --- a/bench/main.hs +++ b/bench/main.hs @@ -28,7 +28,7 @@ checkConsumed _ = error "not consumed" bytestringRead :: ByteString -> Double -bytestringRead = maybe (error "parse error") checkConsumed . R.signed R.floating +bytestringRead = maybe (error "parse error") checkConsumed . R.signed R.fractional text :: ByteString -> Double text = either (const $ error "parse error") checkConsumed . T.signed T.double . T.decodeUtf8 diff --git a/bytestring-read.cabal b/bytestring-read.cabal --- a/bytestring-read.cabal +++ b/bytestring-read.cabal @@ -1,6 +1,6 @@ name: bytestring-read -version: 0.1.0 -synopsis: fast ByteString to Double converting library +version: 0.2.0 +synopsis: fast ByteString to number converting library description: benchmark: license: MIT license-file: LICENSE @@ -15,6 +15,10 @@ library exposed-modules: Data.ByteString.Read + Data.ByteString.Read.Class + Data.ByteString.Read.Fractional + Data.ByteString.Read.Integral + Data.ByteString.Read.DEPRECATED build-depends: base >=4.6 && <4.8 , bytestring >=0.10 && <0.11 , types-compat >=0.1 && <0.2 diff --git a/src/Data/ByteString/Read.hs b/src/Data/ByteString/Read.hs --- a/src/Data/ByteString/Read.hs +++ b/src/Data/ByteString/Read.hs @@ -1,297 +1,35 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE CPP #-} - module Data.ByteString.Read - ( -- * functions - floating + ( -- * fractional + ReadFractional + , fractional , double - , signed - -- * classes - , EffectiveDigit(..) - , Base(..) + -- * integral + , integral + , int - -- * raw functions - , floating10 - , floating' + -- * common + , signed + + -- * DEPRECATED + , module Data.ByteString.Read.DEPRECATED ) where -import Control.Arrow(first) -import Control.Applicative((<$>)) +import Control.Applicative +import Control.Arrow -import Data.ByteString.Unsafe import Data.ByteString(ByteString) +import Data.ByteString.Unsafe import qualified Data.ByteString as S -import Data.Word -import GHC.TypeLits.Compat -import Data.Proxy.Compat +import Data.ByteString.Read.Class +import Data.ByteString.Read.Integral +import Data.ByteString.Read.Fractional +import Data.ByteString.Read.DEPRECATED -- $setup -- >>> :set -XDataKinds -XOverloadedStrings -minus :: Word8 -minus = 45 -{-# INLINE minus #-} - -plus :: Word8 -plus = 43 -{-# INLINE plus #-} - - -class (Fractional a, Num (Fraction a), Ord (Fraction a)) => EffectiveDigit a where - -- | data type to store fractional part of floating - data Fraction a - - -- | maximum value of fractional part. - -- - -- Nothing if arbitrary-precision. - -- - -- @ - -- Just $ fromIntegral (floatRadix t) ^ floatDigits t - -- @ - maxValue :: proxy a -> Maybe (Fraction a) - - -- | lifted fromIntegral - 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 - - {-# INLINE maxValue #-} - {-# INLINE fromFraction #-} - -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 - - {-# INLINE maxValue #-} - {-# INLINE fromFraction #-} - -instance EffectiveDigit Rational where - newtype Fraction Rational = WordRational Integer - deriving(Eq, Ord, Num) - - maxValue _ = Nothing - fromFraction (WordRational a) = fromIntegral a - - {-# INLINE maxValue #-} - {-# INLINE fromFraction #-} - -class KnownNat n => Base n where - -- | check input Word8 is digit charactor or not. - isDigit :: proxy n -> Word8 -> Bool - - -- | convert digit charactor to number. - -- undefined behaviour when give non-digit charactor. - unsafeToDigit :: proxy n -> Word8 -> Word8 - -#define defineBaseUnder10(BASE, MAX)\ -instance Base BASE where;\ - {-# INLINE isDigit #-};\ - {-# INLINE unsafeToDigit #-};\ - 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;\ - {-# INLINE isDigit #-};\ - {-# INLINE unsafeToDigit #-};\ - 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) -{-# INLINABLE integral #-} - -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) -{-# INLINABLE toFractional #-} - --- | convert bytestring into unsigned floating using radix. --- --- this function can parse --- --- * floating(0.1, 12224.3543) --- --- >>> floating' (Proxy :: Proxy 36) "12z" :: Maybe (Double, ByteString) --- Just (1403.0,"") --- >>> floating' (Proxy :: Proxy 2) "1012" :: Maybe (Double, ByteString) --- Just (5.0,"2") --- >>> floating' (Proxy :: Proxy 10) "a12" :: Maybe (Double, ByteString) --- Nothing -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 -{-# INLINABLE floating' #-} - -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) -{-# INLINABLE exponential #-} - -setExpPart :: Fractional f => Int -> f -> f -setExpPart e f - | e >= 0 = f * 10 ^ e - | otherwise = f / 10 ^ abs e -{-# SPECIALIZE setExpPart :: Int -> Double -> Double #-} -{-# SPECIALIZE setExpPart :: Int -> Float -> Float #-} -{-# INLINABLE setExpPart #-} - --- | convert bytestring into unsigned floating using radix. --- --- this function can parse --- --- * floating(0.1, 12224.3543) --- * exponential (e1, E+2, e-123) (optional) --- --- >>> floating10 "12.5" :: Maybe (Double, ByteString) --- Just (12.5,"") --- >>> floating10 "124.1e12" :: Maybe (Double, ByteString) --- Just (1.241e14,"") --- >>> floating10 "12.5e-3" :: Maybe (Double, ByteString) --- Just (1.25e-2,"") --- >>> floating10 "3.11e+3" :: Maybe (Double, ByteString) --- Just (3110.0,"") -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'') -{-# INLINABLE floating10 #-} - --- | convert bytestring into unsigned floating using radix. --- --- this function can parse --- --- * oct/hexa-decimal (0o,0O,0x,0X) (optional) --- * floating(0.1, 12224.3543) --- * exponential (e1, E+2, e-123) (10-radixed only, optional) --- --- >>> floating "12.4" :: Maybe (Double, ByteString) --- Just (12.4,"") --- >>> floating "1.23e12" :: Maybe (Double, ByteString) --- Just (1.23e12,"") --- >>> floating "0o0.4" :: Maybe (Double, ByteString) --- Just (0.5,"") --- >>> floating "0x3f.12" :: Maybe (Double, ByteString) --- Just (63.0703125,"") -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 -{-# INLINABLE floating #-} - --- | @ --- double = floating --- @ -double :: ByteString -> Maybe (Double, ByteString) -double = floating - -- | convert unsigned parser to signed parser. -- -- this function can parse @@ -310,3 +48,6 @@ | unsafeHead s == minus = first negate <$> f (unsafeTail s) | unsafeHead s == plus = f (unsafeTail s) | otherwise = f s + where + minus = 45 + plus = 43 diff --git a/src/Data/ByteString/Read/Class.hs b/src/Data/ByteString/Read/Class.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Read/Class.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE CPP #-} + +module Data.ByteString.Read.Class + ( ReadFractional(..) + , Radix(..) + ) where + +import Data.Word +import GHC.TypeLits.Compat + +class (Fractional a, Num (Fraction a), Ord (Fraction a)) => ReadFractional a where + -- | data type to store fractional part of floating + data Fraction a + + -- | maximum value of fractional part. + -- + -- Nothing if arbitrary-precision. + -- + -- @ + -- Just $ fromIntegral (floatRadix t) ^ floatDigits t + -- @ + maxValue :: proxy a -> Maybe (Fraction a) + + -- | lifted fromIntegral + fromFraction :: Num b => Fraction a -> b + +instance ReadFractional 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 + + {-# INLINE maxValue #-} + {-# INLINE fromFraction #-} + +instance ReadFractional 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 + + {-# INLINE maxValue #-} + {-# INLINE fromFraction #-} + +instance ReadFractional Rational where + newtype Fraction Rational = WordRational Integer + deriving(Eq, Ord, Num) + + maxValue _ = Nothing + fromFraction (WordRational a) = fromIntegral a + + {-# INLINE maxValue #-} + {-# INLINE fromFraction #-} + +class KnownNat n => Radix n where + -- | check input Word8 is digit charactor or not. + isDigit :: proxy n -> Word8 -> Bool + + -- | convert digit charactor to number. + -- undefined behaviour when give non-digit charactor. + unsafeToDigit :: proxy n -> Word8 -> Word8 + +#define defineRadixUnder10(RADIX, MAX)\ +instance Radix RADIX where;\ + {-# INLINE isDigit #-};\ + {-# INLINE unsafeToDigit #-};\ + isDigit _ = \w -> 48 <= w && w <= MAX;\ + unsafeToDigit _ w = w - 48 + +defineRadixUnder10( 2, 49) +defineRadixUnder10( 3, 50) +defineRadixUnder10( 4, 51) +defineRadixUnder10( 5, 52) +defineRadixUnder10( 6, 53) +defineRadixUnder10( 7, 54) +defineRadixUnder10( 8, 55) +defineRadixUnder10( 9, 56) +defineRadixUnder10(10, 57) + +#define defineRadixOver10(RADIX, MAXu, MAXl)\ +instance Radix RADIX where;\ + {-# INLINE isDigit #-};\ + {-# INLINE unsafeToDigit #-};\ + 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 + +defineRadixOver10(11, 65, 97) +defineRadixOver10(12, 66, 98) +defineRadixOver10(13, 67, 99) +defineRadixOver10(14, 68, 100) +defineRadixOver10(15, 69, 101) +defineRadixOver10(16, 70, 102) +defineRadixOver10(17, 71, 103) +defineRadixOver10(18, 72, 104) +defineRadixOver10(19, 73, 105) +defineRadixOver10(20, 74, 106) +defineRadixOver10(21, 75, 107) +defineRadixOver10(22, 76, 108) +defineRadixOver10(23, 77, 109) +defineRadixOver10(24, 78, 110) +defineRadixOver10(25, 79, 111) +defineRadixOver10(26, 80, 112) +defineRadixOver10(27, 81, 113) +defineRadixOver10(28, 82, 114) +defineRadixOver10(29, 83, 115) +defineRadixOver10(30, 84, 116) +defineRadixOver10(31, 85, 117) +defineRadixOver10(32, 86, 118) +defineRadixOver10(33, 87, 119) +defineRadixOver10(34, 88, 120) +defineRadixOver10(35, 89, 121) +defineRadixOver10(36, 90, 122) diff --git a/src/Data/ByteString/Read/DEPRECATED.hs b/src/Data/ByteString/Read/DEPRECATED.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Read/DEPRECATED.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ConstraintKinds #-} + +module Data.ByteString.Read.DEPRECATED where + +import Data.ByteString(ByteString) +import Data.ByteString.Read.Class +import Data.ByteString.Read.Fractional + +{-# DEPRECATED EffectiveDigit "use ReadFractional" #-} +type EffectiveDigit = ReadFractional + +{-# DEPRECATED floating "use fractional" #-} +floating :: EffectiveDigit r => ByteString -> Maybe (r, ByteString) +floating = fractional + +{-# DEPRECATED Base "use Radix" #-} +type Base = Radix + +{-# DEPRECATED floating10 "use fractional10" #-} +floating10 :: forall r. EffectiveDigit r => ByteString -> Maybe (r, ByteString) +floating10 = fractional10 + +{-# DEPRECATED floating' "use floating'" #-} +floating' :: (Base b, EffectiveDigit r) => proxy b -> ByteString -> Maybe (r, ByteString) +floating' = fractional' diff --git a/src/Data/ByteString/Read/Fractional.hs b/src/Data/ByteString/Read/Fractional.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Read/Fractional.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE CPP #-} + +module Data.ByteString.Read.Fractional + ( -- * functions + fractional + , double + + -- * raw functions + , fractional10 + , fractional' + ) where + +import Data.ByteString.Unsafe +import Data.ByteString(ByteString) +import qualified Data.ByteString as S + +import GHC.TypeLits.Compat +import Data.Proxy.Compat + +import Data.ByteString.Read.Class + +-- $setup +-- >>> :set -XDataKinds -XOverloadedStrings + +integral :: forall proxy n r. (Radix n, ReadFractional 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) +{-# INLINABLE integral #-} + +toFractional :: (Radix b, ReadFractional r, Fractional r) + => proxy b -> Fraction r -> Fraction r -> Int -> Int -> r +toFractional p q r du d = fromFraction q * radix ^ du + fromFraction r / radix ^ d + where + radix = fromIntegral (natVal p) +{-# INLINABLE toFractional #-} + +-- | convert bytestring into unsigned fractional using radix. +-- +-- this function can parse +-- +-- * fractional(0.1, 12224.3543) +-- +-- >>> fractional' (Proxy :: Proxy 36) "12z" :: Maybe (Double, ByteString) +-- Just (1403.0,"") +-- >>> fractional' (Proxy :: Proxy 2) "1012" :: Maybe (Double, ByteString) +-- Just (5.0,"2") +-- >>> fractional' (Proxy :: Proxy 10) "a12" :: Maybe (Double, ByteString) +-- Nothing +fractional' :: (Radix b, ReadFractional r) => proxy b -> ByteString -> Maybe (r, ByteString) +fractional' 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 +{-# INLINABLE fractional' #-} + +exponential :: 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 + + minus = 45 + plus = 43 + + 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 Double, Int, Int, ByteString) of + (_, 0, _, _) -> (0, s0) + (e, _, _, s) -> (fromFraction e, s) +{-# INLINABLE exponential #-} + +setExpPart :: Fractional f => Int -> f -> f +setExpPart e f + | e >= 0 = f * 10 ^ e + | otherwise = f / 10 ^ abs e +{-# SPECIALIZE setExpPart :: Int -> Double -> Double #-} +{-# SPECIALIZE setExpPart :: Int -> Float -> Float #-} +{-# INLINABLE setExpPart #-} + +-- | convert bytestring into unsigned fractional using radix. +-- +-- this function can parse +-- +-- * fractional(0.1, 12224.3543) +-- * exponential (e1, E+2, e-123) (optional) +-- +-- >>> fractional10 "12.5" :: Maybe (Double, ByteString) +-- Just (12.5,"") +-- >>> fractional10 "124.1e12" :: Maybe (Double, ByteString) +-- Just (1.241e14,"") +-- >>> fractional10 "12.5e-3" :: Maybe (Double, ByteString) +-- Just (1.25e-2,"") +-- >>> fractional10 "3.11e+3" :: Maybe (Double, ByteString) +-- Just (3110.0,"") +fractional10 :: ReadFractional r => ByteString -> Maybe (r, ByteString) +fractional10 s = fractional' (Proxy :: Proxy 10) s >>= \(f, s') -> + let (e, s'') = exponential s' + in Just (setExpPart e f, s'') +{-# INLINABLE fractional10 #-} + +-- | convert bytestring into unsigned fractional using radix. +-- +-- this function can parse +-- +-- * oct/hexa-decimal (0o,0O,0x,0X) (optional) +-- * fractional(0.1, 12224.3543) +-- * exponential (e1, E+2, e-123) (10-radixed only, optional) +-- +-- >>> fractional "12.4" :: Maybe (Double, ByteString) +-- Just (12.4,"") +-- >>> fractional "1.23e12" :: Maybe (Double, ByteString) +-- Just (1.23e12,"") +-- >>> fractional "0o0.4" :: Maybe (Double, ByteString) +-- Just (0.5,"") +-- >>> fractional "0x3f.12" :: Maybe (Double, ByteString) +-- Just (63.0703125,"") +fractional :: ReadFractional r => ByteString -> Maybe (r, ByteString) +fractional s0 + | S.null s0 = Nothing + | unsafeHead s0 == zero = radix $ unsafeTail s0 + | otherwise = fractional10 s0 + where + zero = 48 + isX w = w == 120 || w == 88 + isO w = w == 111 || w == 79 + + radix s1 + | S.null s1 = Just (0, "") + | isX (unsafeHead s1) = fractional' (Proxy :: Proxy 16) (unsafeTail s1) + | isO (unsafeHead s1) = fractional' (Proxy :: Proxy 8) (unsafeTail s1) + | otherwise = fractional10 s0 +{-# INLINABLE fractional #-} + +-- | @ +-- double = fractional +-- @ +double :: ByteString -> Maybe (Double, ByteString) +double = fractional diff --git a/src/Data/ByteString/Read/Integral.hs b/src/Data/ByteString/Read/Integral.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Read/Integral.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} + +module Data.ByteString.Read.Integral + ( integral' + , integral + , int + ) where + +import Data.ByteString(ByteString) +import qualified Data.ByteString as S +import Data.ByteString.Unsafe + +import Data.Proxy.Compat +import GHC.TypeLits.Compat + +import Data.ByteString.Read.Class + +-- $setup +-- >>> :set -XDataKinds -XOverloadedStrings + +integral_ :: (Radix b, Num n) => proxy b -> ByteString -> (n, Int, ByteString) +integral_ pn = loop 0 0 + where + loop !i !d !s + | S.null s = (i, d, s) + | not (isDigit pn (unsafeHead s)) = (i, d, s) + | otherwise = loop + (i * fromIntegral (natVal pn) + (fromIntegral $ unsafeToDigit pn (unsafeHead s))) + (d+1) (unsafeTail s) +{-# INLINABLE integral_ #-} + +-- | convert bytestring into unsigned integral using radix +-- +-- >>> integral' (Proxy :: Proxy 10) "12345" :: Maybe (Int, ByteString) +-- Just (12345,"") +-- >>> integral' (Proxy :: Proxy 2) "10112" :: Maybe (Int, ByteString) +-- Just (11,"2") +-- >>> integral' (Proxy :: Proxy 36) "Z" :: Maybe (Double, ByteString) +-- Just (35.0,"") +integral' :: (Radix b, Num n) => proxy b -> ByteString -> Maybe (n, ByteString) +integral' pn s0 = case integral_ pn s0 of + (_, 0, _) -> Nothing + (n, _, s) -> Just (n, s) +{-# INLINABLE integral' #-} +-- | @ +-- integral = 'integral'' (Proxy :: Proxy 10) +-- @ +integral :: Num n => ByteString -> Maybe (n, ByteString) +integral = integral' (Proxy :: Proxy 10) +{-# INLINABLE integral #-} + +-- | @ +-- int = integral +-- @ +int :: ByteString -> Maybe (Int, ByteString) +int = integral +{-# INLINABLE int #-} diff --git a/tests/tasty.hs b/tests/tasty.hs --- a/tests/tasty.hs +++ b/tests/tasty.hs @@ -99,59 +99,66 @@ main :: IO () main = defaultMain $ testGroup "read . show == id" - [ testProperty "showEFloat" $ \d -> - let Just (d', "") = signed floating . S.pack $ showEFloat Nothing d "" - in (d :: Double) =~~ d' + [ testGroup "Integral" + [ testProperty "Int" $ \i -> + let Just (i', "") = signed integral . S.pack $ show i + in (i :: Int) == i' + ] + , testGroup "Fractional" + [ testProperty "showEFloat" $ \d -> + let Just (d', "") = signed fractional . S.pack $ showEFloat Nothing d "" + in (d :: Double) =~~ d' - , testProperty "showFFloat" $ \d -> - let Just (d', "") = signed floating . S.pack $ showFFloat Nothing d "" - in (d :: Double) =~~ d' + , testProperty "showFFloat" $ \d -> + let Just (d', "") = signed fractional . S.pack $ showFFloat Nothing d "" + in (d :: Double) =~~ d' - , testProperty "showGFloat" $ \d -> - let Just (d', "") = signed floating . S.pack $ showGFloat Nothing d "" - in (d :: Double) =~~ d' + , testProperty "showGFloat" $ \d -> + let Just (d', "") = signed fractional . S.pack $ showGFloat Nothing d "" + in (d :: Double) =~~ d' - , testProperty "showHex" $ \i -> - let Just (i', "") = signed floating . (S.append "0x") . S.pack $ showHex (abs i) "" - in fromIntegral (abs i :: Int) =~~ i' + , testProperty "showHex" $ \i -> + let Just (i', "") = signed fractional . (S.append "0x") . S.pack $ showHex (abs i) "" + in fromIntegral (abs i :: Int) =~~ i' - , testProperty "showOct" $ \i -> - let Just (i', "") = signed floating . (S.append "0o") . S.pack $ showOct (abs i) "" - in fromIntegral (abs i :: Int) =~~ i' + , testProperty "showOct" $ \i -> + let Just (i', "") = signed fractional . (S.append "0o") . S.pack $ showOct (abs i) "" + in fromIntegral (abs i :: Int) =~~ i' - , testProperty "Word8" $ \(Word8 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Word8" $ \(Word8 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Word10" $ \(Word10 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Word10" $ \(Word10 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Word16" $ \(Word16 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Word16" $ \(Word16 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Int8" $ \(Int8 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Int8" $ \(Int8 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Int10" $ \(Int10 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Int10" $ \(Int10 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Int16" $ \(Int16 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Int16" $ \(Int16 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Float10" $ \(Float10 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Float10" $ \(Float10 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "SmallFloat10" $ \(SmallFloat10 d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "SmallFloat10" $ \(SmallFloat10 d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) - , testProperty "Float10Exp" $ \(Float10Exp d) -> - let Just (d', "") = signed floating (S.pack d) - in d' =~~ (read d :: Double) + , testProperty "Float10Exp" $ \(Float10Exp d) -> + let Just (d', "") = signed fractional (S.pack d) + in d' =~~ (read d :: Double) + ] ]