{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -O2 #-}
module Data.Aeson.Decoding.ByteString (
bsToTokens,
) where
import Data.ByteString (ByteString)
import Data.Char (chr)
import Data.Integer.Conversion (byteStringToInteger)
import Data.Text (Text)
import Data.Word (Word8)
import qualified Data.Aeson.Key as Key
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS.Unsafe
import qualified Data.Scientific as Sci
import Data.Aeson.Decoding.Internal
import Data.Aeson.Decoding.Tokens
import Data.Aeson.Internal.Text (unsafeDecodeASCII)
import Data.Aeson.Internal.Unescape (unescapeText)
import Data.Aeson.Internal.Word8
bsToTokens :: ByteString -> Tokens ByteString String
bsToTokens :: ByteString -> Tokens ByteString String
bsToTokens ByteString
bs0 = forall k. Parser Tokens k
goT ByteString
bs0 forall a. a -> a
id where
goT :: Parser Tokens k
goT :: forall k. Parser Tokens k
goT (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr String
"Unexpected end-of-input, expecting JSON value"
Just (!Word8
w, !ByteString
bs1) -> forall k.
Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
tokenCase Word8
w ByteString
bs1 ByteString
bs ByteString -> k
k
tokenCase
:: Word8
-> ByteString
-> ByteString
-> (ByteString -> k)
-> Tokens k String
tokenCase :: forall k.
Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
tokenCase Word8
W8_OPEN_CURLY !ByteString
bs !ByteString
_ ByteString -> k
k = forall k e. TkRecord k e -> Tokens k e
TkRecordOpen (forall k. Parser TkRecord k
goR ByteString
bs ByteString -> k
k)
tokenCase Word8
W8_OPEN_SQUARE ByteString
bs ByteString
_ ByteString -> k
k = forall k e. TkArray k e -> Tokens k e
TkArrayOpen (forall k. Parser TkArray k
goA ByteString
bs ByteString -> k
k)
tokenCase Word8
W8_DOUBLE_QUOTE ByteString
bs ByteString
_ ByteString -> k
k = forall r.
(Text -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanStringLiteral (\Text
t ByteString
bs' -> forall k e. Text -> k -> Tokens k e
TkText Text
t (ByteString -> k
k ByteString
bs')) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
bs
tokenCase Word8
W8_MINUS ByteString
bs ByteString
_ ByteString -> k
k = forall r.
(Number -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanNumberLiteral (\Number
n ByteString
bs' -> forall k e. Number -> k -> Tokens k e
TkNumber (Number -> Number
negateNumber Number
n) (ByteString -> k
k ByteString
bs')) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
bs
tokenCase Word8
w ByteString
_ ByteString
wbs ByteString -> k
k
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w, Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 = forall r.
(Number -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanNumberLiteral (\Number
n ByteString
bs' -> forall k e. Number -> k -> Tokens k e
TkNumber Number
n (ByteString -> k
k ByteString
bs')) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
wbs
tokenCase Word8
W8_n ByteString
bs ByteString
_ ByteString -> k
k
| Just ByteString
bs1 <- ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
"ull" Int
3 ByteString
bs = forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitNull (ByteString -> k
k ByteString
bs1)
tokenCase Word8
W8_t ByteString
bs ByteString
_ ByteString -> k
k
| Just ByteString
bs1 <- ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
"rue" Int
3 ByteString
bs = forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitTrue (ByteString -> k
k ByteString
bs1)
tokenCase Word8
W8_f ByteString
bs ByteString
_ ByteString -> k
k
| Just ByteString
bs1 <- ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
"alse" Int
4 ByteString
bs = forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitFalse (ByteString -> k
k ByteString
bs1)
tokenCase Word8
_ ByteString
_ ByteString
wbs ByteString -> k
_ = forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ ByteString -> String
showBeginning ByteString
wbs forall a. [a] -> [a] -> [a]
++ String
", expecting JSON value"
goA :: Parser TkArray k
goA :: forall k. Parser TkArray k
goA (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"JSON value or ]"
Just (Word8
W8_CLOSE_SQUARE, !ByteString
bs1) -> forall k e. k -> TkArray k e
TkArrayEnd (ByteString -> k
k ByteString
bs1)
Just (Word8
w, !ByteString
bs1) -> forall k e. Tokens (TkArray k e) e -> TkArray k e
TkItem forall a b. (a -> b) -> a -> b
$ forall k.
Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
tokenCase Word8
w ByteString
bs1 ByteString
bs forall a b. (a -> b) -> a -> b
$ \ByteString
bs2 -> forall k. Parser TkArray k
goA1 ByteString
bs2 ByteString -> k
k
goA1 :: Parser TkArray k
goA1 :: forall k. Parser TkArray k
goA1 (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
", or ]"
Just (Word8
W8_CLOSE_SQUARE, !ByteString
bs1) -> forall k e. k -> TkArray k e
TkArrayEnd (ByteString -> k
k ByteString
bs1)
Just (Word8
W8_COMMA, !ByteString
bs1) -> forall k e. Tokens (TkArray k e) e -> TkArray k e
TkItem forall a b. (a -> b) -> a -> b
$ forall k. Parser Tokens k
goT ByteString
bs1 forall a b. (a -> b) -> a -> b
$ \ByteString
bs2 -> forall k. Parser TkArray k
goA1 ByteString
bs2 ByteString -> k
k
Maybe (Word8, ByteString)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
", or ]"
goR :: Parser TkRecord k
goR :: forall k. Parser TkRecord k
goR (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"record key literal or }"
Just (Word8
W8_DOUBLE_QUOTE, !ByteString
bs1) -> forall k. Parser TkRecord k
goRK ByteString
bs1 ByteString -> k
k
Just (Word8
W8_CLOSE_CURLY, !ByteString
bs1) -> forall k e. k -> TkRecord k e
TkRecordEnd (ByteString -> k
k ByteString
bs1)
Just (Word8, ByteString)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
"record key literal or }"
goR1 :: Parser TkRecord k
goR1 :: forall k. Parser TkRecord k
goR1 (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr String
"Unexpected end-of-input, expecting , or }"
Just (Word8
W8_COMMA, !ByteString
bs1) -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons (ByteString -> ByteString
skipSpace ByteString
bs1) of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"key literal"
Just (Word8
W8_DOUBLE_QUOTE, !ByteString
bs2) -> forall k. Parser TkRecord k
goRK ByteString
bs2 ByteString -> k
k
Just (Word8, ByteString)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
"key literal"
Just (Word8
W8_CLOSE_CURLY, !ByteString
bs1) -> forall k e. k -> TkRecord k e
TkRecordEnd (ByteString -> k
k ByteString
bs1)
Maybe (Word8, ByteString)
_ -> forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ ByteString -> String
showBeginning ByteString
bs forall a. [a] -> [a] -> [a]
++ String
", expecting , or }"
goRK :: Parser TkRecord k
goRK :: forall k. Parser TkRecord k
goRK ByteString
bs1 ByteString -> k
k = forall r.
(Text -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanStringLiteral (\Text
t ByteString
bs -> forall k. Text -> Parser TkRecord k
goRK' Text
t ByteString
bs ByteString -> k
k) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
bs1
goRK' :: Text -> Parser TkRecord k
goRK' :: forall k. Text -> Parser TkRecord k
goRK' Text
t (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
":"
Just (Word8
W8_COLON, !ByteString
bs3) -> forall k e. Key -> Tokens (TkRecord k e) e -> TkRecord k e
TkPair (Text -> Key
Key.fromText Text
t) forall a b. (a -> b) -> a -> b
$ forall k. Parser Tokens k
goT ByteString
bs3 forall a b. (a -> b) -> a -> b
$ \ByteString
bs4 -> forall k. Parser TkRecord k
goR1 ByteString
bs4 ByteString -> k
k
Just (Word8, ByteString)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
":"
stripPrefix :: ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix :: ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
pfx Int
n ByteString
bs | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
pfx ByteString
bs = forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
BS.Unsafe.unsafeDrop Int
n ByteString
bs)
| Bool
otherwise = forall a. Maybe a
Nothing
{-# INLINE stripPrefix #-}
type Parser tk k = ByteString -> (ByteString -> k) -> tk k String
showBeginning :: ByteString -> String
showBeginning :: ByteString -> String
showBeginning = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
30
skipSpace :: ByteString -> ByteString
skipSpace :: ByteString -> ByteString
skipSpace = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x09
{-# INLINE skipSpace #-}
tkErrEOF :: AsError t =>String -> t k String
tkErrEOF :: forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
expected = forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr forall a b. (a -> b) -> a -> b
$
String
"Unexpected end-of-input, expecting " forall a. [a] -> [a] -> [a]
++ String
expected
{-# INLINE tkErrEOF #-}
tkErrBS :: AsError t => ByteString -> String -> t k String
tkErrBS :: forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
expected = forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr forall a b. (a -> b) -> a -> b
$
String
"Unexpected " forall a. [a] -> [a] -> [a]
++ ByteString -> String
showBeginning ByteString
bs forall a. [a] -> [a] -> [a]
++ String
", expecting " forall a. [a] -> [a] -> [a]
++ String
expected
{-# INLINE tkErrBS #-}
scanStringLiteral
:: forall r. (Text -> ByteString -> r)
-> (String -> r)
-> ByteString
-> r
scanStringLiteral :: forall r.
(Text -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanStringLiteral Text -> ByteString -> r
ok String -> r
err ByteString
bs0 = Int -> ByteString -> r
go Int
0 ByteString
bs0 where
go :: Int -> ByteString -> r
go :: Int -> ByteString -> r
go !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
34, ByteString
_) -> Text -> ByteString -> r
ok (ByteString -> Text
unsafeDecodeASCII (Int -> ByteString -> ByteString
BS.Unsafe.unsafeTake Int
n ByteString
bs0)) (Int -> ByteString -> ByteString
BS.Unsafe.unsafeDrop (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs0)
Just (Word8
92, ByteString
bs') -> Int -> ByteString -> r
goSlash (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
Just (Word8
w8, ByteString
bs')
| Word8
w8 forall a. Ord a => a -> a -> Bool
< Word8
0x20 -> r
errCC
| Word8
w8 forall a. Ord a => a -> a -> Bool
>= Word8
0x80 -> Int -> ByteString -> r
goEsc (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
| Bool
otherwise -> Int -> ByteString -> r
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
goEsc :: Int -> ByteString -> r
goEsc :: Int -> ByteString -> r
goEsc !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
34, ByteString
_) -> case ByteString -> Either UnicodeException Text
unescapeText (Int -> ByteString -> ByteString
BS.Unsafe.unsafeTake Int
n ByteString
bs0) of
Right Text
t -> Text -> ByteString -> r
ok Text
t (Int -> ByteString -> ByteString
BS.drop (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs0)
Left UnicodeException
e -> String -> r
err (forall a. Show a => a -> String
show UnicodeException
e)
Just (Word8
92, ByteString
bs') -> Int -> ByteString -> r
goSlash (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
Just (Word8
_, ByteString
bs') -> Int -> ByteString -> r
goEsc (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
goSlash :: Int -> ByteString -> r
goSlash :: Int -> ByteString -> r
goSlash !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
_, ByteString
bs') -> Int -> ByteString -> r
goEsc (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
errEnd :: r
errEnd = String -> r
err String
"Unexpected end-of-input while parsing string literal"
errCC :: r
errCC = String -> r
err String
"Unespected control character while parsing string literal"
scanNumberLiteral
:: forall r. (Number -> ByteString -> r)
-> (String -> r)
-> ByteString
-> r
scanNumberLiteral :: forall r.
(Number -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanNumberLiteral Number -> ByteString -> r
kont String -> r
err ByteString
bs0 = ByteString -> r
state_start ByteString
bs0 where
state_start :: ByteString -> r
state_start :: ByteString -> r
state_start !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
< Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Int -> ByteString -> r
state_i1 Int
1 ByteString
bs'
| Word8
W8_0 forall a. Eq a => a -> a -> Bool
== Word8
w8 -> ByteString -> r
state_after0 ByteString
bs'
| Bool
otherwise -> String -> r
err forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w8 forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"
state_after0 :: ByteString -> r
state_after0 :: ByteString -> r
state_after0 !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
0) ByteString
bs
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> String -> r
err String
"Number literal with leading zero"
| Word8
W8_DOT forall a. Eq a => a -> a -> Bool
== Word8
w8 -> Integer -> ByteString -> r
go_dec Integer
0 ByteString
bs'
| Word8
W8_e forall a. Eq a => a -> a -> Bool
== Word8
w8 Bool -> Bool -> Bool
|| Word8
W8_E forall a. Eq a => a -> a -> Bool
== Word8
w8 -> Integer -> Int -> ByteString -> r
go_sci Integer
0 Int
0 ByteString
bs'
| Bool
otherwise -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
0) ByteString
bs
state_i1 :: Int -> ByteString -> r
state_i1 :: Int -> ByteString -> r
state_i1 !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
int) ByteString
bs
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Int -> ByteString -> r
state_i1 (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
| Word8
W8_DOT forall a. Eq a => a -> a -> Bool
== Word8
w8 -> Integer -> ByteString -> r
go_dec Integer
int ByteString
bs'
| Word8
W8_e forall a. Eq a => a -> a -> Bool
== Word8
w8 Bool -> Bool -> Bool
|| Word8
W8_E forall a. Eq a => a -> a -> Bool
== Word8
w8 -> Integer -> Int -> ByteString -> r
go_sci Integer
int Int
0 ByteString
bs'
| Bool
otherwise -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
int) ByteString
bs
where
int :: Integer
int = ByteString -> Integer
byteStringToInteger (Int -> ByteString -> ByteString
BS.Unsafe.unsafeTake Int
n ByteString
bs0)
go_dec :: Integer -> ByteString -> r
go_dec :: Integer -> ByteString -> r
go_dec !Integer
int !ByteString
bs1 = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs1 of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Int -> ByteString -> r
state_dec Int
1 ByteString
bs'
| Bool
otherwise -> String -> r
err forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w8 forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"
where
state_dec :: Int -> ByteString -> r
state_dec :: Int -> ByteString -> r
state_dec !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> Number -> ByteString -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) ByteString
bs
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Int -> ByteString -> r
state_dec (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
| Word8
W8_e forall a. Eq a => a -> a -> Bool
== Word8
w8 Bool -> Bool -> Bool
|| Word8
W8_E forall a. Eq a => a -> a -> Bool
== Word8
w8 -> Integer -> Int -> ByteString -> r
go_sci Integer
coef (forall a. Num a => a -> a
negate Int
n) ByteString
bs'
| Bool
otherwise -> Number -> ByteString -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) ByteString
bs
where
frac :: Integer
frac = ByteString -> Integer
byteStringToInteger (Int -> ByteString -> ByteString
BS.Unsafe.unsafeTake Int
n ByteString
bs1)
coef :: Integer
coef = Integer
int forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n forall a. Num a => a -> a -> a
+ Integer
frac
dec :: Scientific
dec = Integer -> Int -> Scientific
Sci.scientific Integer
coef (forall a. Num a => a -> a
negate Int
n)
go_sci :: Integer -> Int -> ByteString -> r
go_sci :: Integer -> Int -> ByteString -> r
go_sci !Integer
coef !Int
exp10 !ByteString
bs2 = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs2 of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos Integer
coef Int
exp10 ByteString
bs2 Int
1 ByteString
bs'
| Word8
W8_PLUS forall a. Eq a => a -> a -> Bool
== Word8
w8 -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
w8', ByteString
bs'')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8', Word8
w8' forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos Integer
coef Int
exp10 ByteString
bs' Int
1 ByteString
bs''
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Word8
w8'
| Word8
W8_MINUS forall a. Eq a => a -> a -> Bool
== Word8
w8 -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
Maybe (Word8, ByteString)
Nothing -> r
errEnd
Just (Word8
w8', ByteString
bs'')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8', Word8
w8' forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg Integer
coef Int
exp10 ByteString
bs' Int
1 ByteString
bs''
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Word8
w8'
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Word8
w8
go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos !Integer
coef !Int
exp10 !ByteString
bs2 !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos Integer
coef Int
exp10 ByteString
bs2 (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
| Bool
otherwise -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
where
exp10' :: Int
exp10' = forall a. Num a => Integer -> a
fromInteger (ByteString -> Integer
byteStringToInteger (Int -> ByteString -> ByteString
BS.Unsafe.unsafeTake Int
n ByteString
bs2))
sci :: Scientific
sci = Integer -> Int -> Scientific
Sci.scientific Integer
coef (Int
exp10 forall a. Num a => a -> a -> a
+ Int
exp10')
go_sci_neg :: Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg :: Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg !Integer
coef !Int
exp10 !ByteString
bs2 !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
Just (Word8
w8, ByteString
bs')
| Word8
W8_0 forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 forall a. Ord a => a -> a -> Bool
<= Word8
W8_9 -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg Integer
coef Int
exp10 ByteString
bs2 (Int
n forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
| Bool
otherwise -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
where
exp10' :: Int
exp10' = forall a. Num a => Integer -> a
fromInteger (ByteString -> Integer
byteStringToInteger (Int -> ByteString -> ByteString
BS.Unsafe.unsafeTake Int
n ByteString
bs2))
sci :: Scientific
sci = Integer -> Int -> Scientific
Sci.scientific Integer
coef (Int
exp10 forall a. Num a => a -> a -> a
- Int
exp10')
errEnd :: r
errEnd = String -> r
err String
"Unexpected end-of-input while parsing number literal"
errUnx :: a -> r
errUnx a
w8 = String -> r
err forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w8)) forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"