packages feed

bytestring-read (empty) → 0.1.0

raw patch · 7 files changed

+607/−0 lines, 7 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, bytestring-lexing, bytestring-read, criterion, doctest, scientific, tasty, tasty-quickcheck, text, types-compat

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 philopon++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/main.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Criterion.Main++import Data.ByteString(ByteString)+import qualified Data.ByteString.Char8 as SC++import qualified Data.Text.Encoding as T++import Data.Scientific(toRealFloat)+import Data.String(IsString)++import qualified Data.ByteString.Read as R+import qualified Data.Text.Read as T+import qualified Data.ByteString.Lex.Double as L+import qualified Data.Attoparsec.ByteString.Char8 as A++short :: ByteString+short = "-2342395232123424.3424346343524e3"++long :: ByteString+long = "-234232345678976521345895325678987654321345678987654321345689643213595232123424.34243463435223456789321367899231808534492500740957389523850293482093852039587495203586329850238562834290374029844e3"++checkConsumed :: (IsString a, Eq a) => (v, a) -> v+checkConsumed (d, "") = d+checkConsumed _       = error "not consumed"++bytestringRead :: ByteString -> Double+bytestringRead = maybe (error "parse error") checkConsumed . R.signed R.floating++text :: ByteString -> Double+text = either (const $ error "parse error") checkConsumed . T.signed T.double . T.decodeUtf8++bytestringLexing :: ByteString -> Double+bytestringLexing = maybe (error "parse error") checkConsumed . L.readDouble++attoparsec :: ByteString -> Double+attoparsec = either (const $ error "parse error") id . A.parseOnly (fmap toRealFloat A.scientific)++read' :: ByteString -> Double+read' = read . SC.unpack++doBench :: String -> (ByteString -> Double) -> Benchmark+doBench n f = bgroup n+    [ bench "short" $ nf f short+    , bench "long"  $ nf f long+    ]++main :: IO ()+main = defaultMain+    [ doBench "bytestring-read" bytestringRead+    , doBench "text" text+    , doBench "bytestring-lexing" bytestringLexing+    , doBench "attoparsec" attoparsec+    , doBench "read" read'+    ]
+ bytestring-read.cabal view
@@ -0,0 +1,56 @@+name:                bytestring-read+version:             0.1.0+synopsis:            fast ByteString to Double converting library+description:         benchmark: <http://philopon.github.io/bytestring-read/bench.html>+license:             MIT+license-file:        LICENSE+author:              HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer:          HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage:            https://github.com/philopon/bytestring-read+Bug-reports:         https://github.com/philopon/bytestring-read/issues+copyright:           (c) 2015 Hirotomo Moriwaki+category:            Data+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Data.ByteString.Read+  build-depends:       base         >=4.6  && <4.8+                     , bytestring   >=0.10 && <0.11+                     , types-compat >=0.1  && <0.2+  hs-source-dirs:      src+  ghc-options:         -Wall -O2+  default-language:    Haskell2010++benchmark bench+  type:                exitcode-stdio-1.0+  main-is:             bench/main.hs+  build-depends:       base+                     , bytestring-read+                     , bytestring        >=0.10 && <0.11+                     , text+                     , bytestring-lexing >=0.4  && <0.5+                     , criterion         >=1.0  && <1.1+                     , scientific+                     , attoparsec+  ghc-options:         -Wall -O2+  default-language:    Haskell2010++test-suite tasty+  type:                exitcode-stdio-1.0+  main-is:             tests/tasty.hs+  build-depends:       base+                     , bytestring-read+                     , bytestring        >=0.10 && <0.11+                     , tasty             >=0.10 && <0.11+                     , tasty-quickcheck  >=0.8  && <0.9+  ghc-options:         -Wall -O2+  default-language:    Haskell2010++test-suite doctests+  type:                exitcode-stdio-1.0+  ghc-options:         -threaded+  main-is:             tests/doctest.hs+  build-depends:       base    >=4.6 && <4.8+                     , doctest >=0.9 && <0.10+  default-language:    Haskell2010
+ src/Data/ByteString/Read.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-}++module Data.ByteString.Read+    ( -- * functions+      floating+    , double+    , signed++    -- * classes+    , EffectiveDigit(..)+    , Base(..)++     -- * raw functions+    , 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++-- $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+--+-- * sign (+, -) (optional)+--+-- >>> signed double "12.4"+-- Just (12.4,"")+-- >>> signed double "-3.21e3"+-- Just (-3210.0,"")+-- >>> signed double "+0x1f.4"+-- Just (31.25,"")+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
+ tests/doctest.hs view
@@ -0,0 +1,2 @@+import Test.DocTest+main = doctest ["-isrc", "src/Data/ByteString/Read.hs"]
+ tests/tasty.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}+import Numeric+import Control.Monad+import qualified Data.ByteString.Char8 as S+import Data.ByteString.Read+import Test.Tasty+import Test.Tasty.QuickCheck++(=~~) :: Double -> Double -> Bool+(=~~) a b = a == b || abs (a - b) <= max (abs a) (abs b) * 1e20++-- Word++newtype Word8 = Word8 String+    deriving Show++instance Arbitrary Word8 where+    arbitrary = do+        i <- choose (1, 50)+        n <- replicateM i $ choose ('0', '7')+        return $ Word8 $ "0o" ++ n++newtype Word10 = Word10 String+    deriving Show++instance Arbitrary Word10 where+    arbitrary = do+        i <- choose (1, 50)+        n <- replicateM i $ choose ('0', '9')+        return $ Word10 n++newtype Word16 = Word16 String+    deriving Show++instance Arbitrary Word16 where+    arbitrary = do+        i <- choose (1, 50)+        n <- replicateM i $ oneof [choose ('0', '9'), choose ('a', 'f'), choose ('A', 'F')]+        return $ Word16 $ "0x" ++ n++-- Int+newtype Int8 = Int8 String+    deriving Show++instance Arbitrary Int8 where+    arbitrary = do+        sign <- oneof $ map return ["", "-"]+        Word8 w <- arbitrary+        return . Int8 $ sign ++ w++newtype Int10 = Int10 String+    deriving Show++instance Arbitrary Int10 where+    arbitrary = do+        sign <- oneof $ map return ["", "-"]+        Word10 w <- arbitrary+        return . Int10 $ sign ++ w++newtype Int16 = Int16 String+    deriving Show++instance Arbitrary Int16 where+    arbitrary = do+        sign <- oneof $ map return ["", "-"]+        Word16 w <- arbitrary+        return . Int16 $ sign ++ w++-- Float+newtype Float10 = Float10 String+    deriving Show++instance Arbitrary Float10 where+    arbitrary = do+        Int10 q <- arbitrary+        Word10 r <- arbitrary+        return . Float10 $ q ++ '.': r++newtype SmallFloat10 = SmallFloat10 String+    deriving Show++instance Arbitrary SmallFloat10 where+    arbitrary = do+        sign <- oneof $ map return ["", "-"]+        i <- choose (0, 100)+        Word10 r <- arbitrary+        return . SmallFloat10 $ sign ++ "0." ++ replicate i '0' ++ r++newtype Float10Exp = Float10Exp String+    deriving Show++instance Arbitrary Float10Exp where+    arbitrary = do+        Float10 f <- arbitrary+        c <- oneof $ map return "eE"+        s <- oneof $ map return ["", "+", "-"]+        e <- choose (0, 10000 :: Int)+        return . Float10Exp $ f ++ c: s ++ show e ++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'++    , testProperty "showFFloat" $ \d ->+        let Just (d', "") = signed floating . 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 "showHex" $ \i ->+        let Just (i', "") = signed floating . (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 "Word8" $ \(Word8 d) ->+        let Just (d', "") = signed floating (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 "Word16" $ \(Word16 d) ->+        let Just (d', "") = signed floating (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 "Int10" $ \(Int10 d) ->+        let Just (d', "") = signed floating (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 "Float10" $ \(Float10 d) ->+        let Just (d', "") = signed floating (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 "Float10Exp" $ \(Float10Exp d) ->+        let Just (d', "") = signed floating (S.pack d)+        in d' =~~ (read d :: Double)+     ]