{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -O2 #-}
module Data.Aeson.Decoding.Text (
textToTokens,
) where
import Data.Char (chr)
import Data.Integer.Conversion (textToInteger)
import Data.Text.Internal (Text (..))
import qualified Data.Aeson.Key as Key
import qualified Data.Scientific as Sci
import qualified Data.Text as T
import qualified Data.Text.Array as A
import Data.Aeson.Decoding.Internal
import Data.Aeson.Decoding.Tokens
import Data.Aeson.Internal.Prelude
import Data.Aeson.Internal.UnescapeFromText (unescapeFromText)
#if MIN_VERSION_text(2,0,0)
import Data.Aeson.Internal.Word8
#else
import Data.Aeson.Internal.Word16
#endif
#if MIN_VERSION_text(2,0,0)
type Point = Word8
#else
type Point = Word16
#endif
textToTokens :: Text -> Tokens Text String
textToTokens :: Text -> Tokens Text String
textToTokens Text
bs0 = forall k. Parser Tokens k
goT Text
bs0 forall a. a -> a
id where
goT :: Parser Tokens k
goT :: forall k. Parser Tokens k
goT (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr String
"Unexpected end-of-input, expecting JSON value"
Just (!Point
w, !Text
bs1) -> forall k. Point -> Text -> Text -> (Text -> k) -> Tokens k String
tokenCase Point
w Text
bs1 Text
bs Text -> k
k
tokenCase
:: Point
-> Text
-> Text
-> (Text -> k)
-> Tokens k String
tokenCase :: forall k. Point -> Text -> Text -> (Text -> k) -> Tokens k String
tokenCase Point
W8_OPEN_CURLY !Text
bs !Text
_ Text -> k
k = forall k e. TkRecord k e -> Tokens k e
TkRecordOpen (forall k. Parser TkRecord k
goR Text
bs Text -> k
k)
tokenCase Point
W8_OPEN_SQUARE Text
bs Text
_ Text -> k
k = forall k e. TkArray k e -> Tokens k e
TkArrayOpen (forall k. Parser TkArray k
goA Text
bs Text -> k
k)
tokenCase Point
W8_DOUBLE_QUOTE Text
bs Text
_ Text -> k
k = forall r. (Text -> Text -> r) -> (String -> r) -> Text -> r
scanStringLiteral (\Text
t Text
bs' -> forall k e. Text -> k -> Tokens k e
TkText Text
t (Text -> k
k Text
bs')) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
bs
tokenCase Point
W8_MINUS Text
bs Text
_ Text -> k
k = forall r. (Number -> Text -> r) -> (String -> r) -> Text -> r
scanNumberLiteral (\Number
n Text
bs' -> forall k e. Number -> k -> Tokens k e
TkNumber (Number -> Number
negateNumber Number
n) (Text -> k
k Text
bs')) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
bs
tokenCase Point
w Text
_ Text
wbs Text -> k
k
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w, Point
w forall a. Ord a => a -> a -> Bool
<= Point
W8_9 = forall r. (Number -> Text -> r) -> (String -> r) -> Text -> r
scanNumberLiteral (\Number
n Text
bs' -> forall k e. Number -> k -> Tokens k e
TkNumber Number
n (Text -> k
k Text
bs')) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
wbs
tokenCase Point
W8_n Text
bs Text
_ Text -> k
k
| Just Text
bs1 <- Text -> Int -> Text -> Maybe Text
stripPrefix Text
"ull" Int
3 Text
bs = forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitNull (Text -> k
k Text
bs1)
tokenCase Point
W8_t Text
bs Text
_ Text -> k
k
| Just Text
bs1 <- Text -> Int -> Text -> Maybe Text
stripPrefix Text
"rue" Int
3 Text
bs = forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitTrue (Text -> k
k Text
bs1)
tokenCase Point
W8_f Text
bs Text
_ Text -> k
k
| Just Text
bs1 <- Text -> Int -> Text -> Maybe Text
stripPrefix Text
"alse" Int
4 Text
bs = forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitFalse (Text -> k
k Text
bs1)
tokenCase Point
_ Text
_ Text
wbs Text -> 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]
++ Text -> String
showBeginning Text
wbs forall a. [a] -> [a] -> [a]
++ String
", expecting JSON value"
goA :: Parser TkArray k
goA :: forall k. Parser TkArray k
goA (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"JSON value or ]"
Just (Point
W8_CLOSE_SQUARE, !Text
bs1) -> forall k e. k -> TkArray k e
TkArrayEnd (Text -> k
k Text
bs1)
Just (Point
w, !Text
bs1) -> forall k e. Tokens (TkArray k e) e -> TkArray k e
TkItem forall a b. (a -> b) -> a -> b
$ forall k. Point -> Text -> Text -> (Text -> k) -> Tokens k String
tokenCase Point
w Text
bs1 Text
bs forall a b. (a -> b) -> a -> b
$ \Text
bs2 -> forall k. Parser TkArray k
goA1 Text
bs2 Text -> k
k
goA1 :: Parser TkArray k
goA1 :: forall k. Parser TkArray k
goA1 (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
", or ]"
Just (Point
W8_CLOSE_SQUARE, !Text
bs1) -> forall k e. k -> TkArray k e
TkArrayEnd (Text -> k
k Text
bs1)
Just (Point
W8_COMMA, !Text
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 Text
bs1 forall a b. (a -> b) -> a -> b
$ \Text
bs2 -> forall k. Parser TkArray k
goA1 Text
bs2 Text -> k
k
Maybe (Point, Text)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
", or ]"
goR :: Parser TkRecord k
goR :: forall k. Parser TkRecord k
goR (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"record key literal or }"
Just (Point
W8_DOUBLE_QUOTE, !Text
bs1) -> forall k. Parser TkRecord k
goRK Text
bs1 Text -> k
k
Just (Point
W8_CLOSE_CURLY, !Text
bs1) -> forall k e. k -> TkRecord k e
TkRecordEnd (Text -> k
k Text
bs1)
Just (Point, Text)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
"record key literal or }"
goR1 :: Parser TkRecord k
goR1 :: forall k. Parser TkRecord k
goR1 (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr String
"Unexpected end-of-input, expecting , or }"
Just (Point
W8_COMMA, !Text
bs1) -> case Text -> Maybe (Point, Text)
unconsPoint (Text -> Text
skipSpace Text
bs1) of
Maybe (Point, Text)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"key literal"
Just (Point
W8_DOUBLE_QUOTE, !Text
bs2) -> forall k. Parser TkRecord k
goRK Text
bs2 Text -> k
k
Just (Point, Text)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
"key literal"
Just (Point
W8_CLOSE_CURLY, !Text
bs1) -> forall k e. k -> TkRecord k e
TkRecordEnd (Text -> k
k Text
bs1)
Maybe (Point, Text)
_ -> 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]
++ Text -> String
showBeginning Text
bs forall a. [a] -> [a] -> [a]
++ String
", expecting , or }"
goRK :: Parser TkRecord k
goRK :: forall k. Parser TkRecord k
goRK Text
bs1 Text -> k
k = forall r. (Text -> Text -> r) -> (String -> r) -> Text -> r
scanStringLiteral (\Text
t Text
bs -> forall k. Text -> Parser TkRecord k
goRK' Text
t Text
bs Text -> k
k) forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
bs1
goRK' :: Text -> Parser TkRecord k
goRK' :: forall k. Text -> Parser TkRecord k
goRK' Text
t (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Char, Text)
T.uncons Text
bs of
Maybe (Char, Text)
Nothing -> forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
":"
Just (Char
':', !Text
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 Text
bs3 forall a b. (a -> b) -> a -> b
$ \Text
bs4 -> forall k. Parser TkRecord k
goR1 Text
bs4 Text -> k
k
Just (Char, Text)
_ -> forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
":"
stripPrefix :: Text -> Int -> Text -> Maybe Text
stripPrefix :: Text -> Int -> Text -> Maybe Text
stripPrefix Text
pfx Int
_ Text
bs = Text -> Text -> Maybe Text
T.stripPrefix Text
pfx Text
bs
{-# INLINE stripPrefix #-}
type Parser tk k = Text -> (Text -> k) -> tk k String
showBeginning :: Text -> String
showBeginning :: Text -> String
showBeginning = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
30
skipSpace :: Text -> Text
skipSpace :: Text -> Text
skipSpace = (Char -> Bool) -> Text -> Text
T.dropWhile forall a b. (a -> b) -> a -> b
$ \Char
w -> Char
w forall a. Eq a => a -> a -> Bool
== Char
'\x20' Bool -> Bool -> Bool
|| Char
w forall a. Eq a => a -> a -> Bool
== Char
'\x0a' Bool -> Bool -> Bool
|| Char
w forall a. Eq a => a -> a -> Bool
== Char
'\x0d' Bool -> Bool -> Bool
|| Char
w forall a. Eq a => a -> a -> Bool
== Char
'\x09'
{-# 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 => Text -> String -> t k String
tkErrBS :: forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
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]
++ Text -> String
showBeginning Text
bs forall a. [a] -> [a] -> [a]
++ String
", expecting " forall a. [a] -> [a] -> [a]
++ String
expected
{-# INLINE tkErrBS #-}
scanStringLiteral
:: forall r. (Text -> Text -> r)
-> (String -> r)
-> Text
-> r
scanStringLiteral :: forall r. (Text -> Text -> r) -> (String -> r) -> Text -> r
scanStringLiteral Text -> Text -> r
ok String -> r
err Text
bs0 = Int -> Text -> r
go Int
0 Text
bs0 where
go :: Int -> Text -> r
go :: Int -> Text -> r
go !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
34, Text
_) -> Text -> Text -> r
ok (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs0) (Int -> Text -> Text
unsafeDropPoints (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs0)
Just (Point
92, Text
bs') -> Int -> Text -> r
goSlash (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
Just (Point
w8, Text
bs')
| Point
w8 forall a. Ord a => a -> a -> Bool
< Point
0x20 -> r
errCC
| Bool
otherwise -> Int -> Text -> r
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
goEsc :: Int -> Text -> r
goEsc :: Int -> Text -> r
goEsc !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
34, Text
_) -> case Text -> Either UnicodeException Text
unescapeFromText (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs0) of
Right Text
t -> Text -> Text -> r
ok Text
t (Int -> Text -> Text
unsafeDropPoints (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs0)
Left UnicodeException
e -> String -> r
err (forall a. Show a => a -> String
show UnicodeException
e)
Just (Point
92, Text
bs') -> Int -> Text -> r
goSlash (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
Just (Point
_, Text
bs') -> Int -> Text -> r
goEsc (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
goSlash :: Int -> Text -> r
goSlash :: Int -> Text -> r
goSlash !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
_, Text
bs') -> Int -> Text -> r
goEsc (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
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 -> Text -> r)
-> (String -> r)
-> Text
-> r
scanNumberLiteral :: forall r. (Number -> Text -> r) -> (String -> r) -> Text -> r
scanNumberLiteral Number -> Text -> r
kont String -> r
err Text
bs0 = Text -> r
state_start Text
bs0 where
state_start :: Text -> r
state_start :: Text -> r
state_start !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
< Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Int -> Text -> r
state_i1 Int
1 Text
bs'
| Point
W8_0 forall a. Eq a => a -> a -> Bool
== Point
w8 -> Text -> r
state_after0 Text
bs'
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Point
w8
state_after0 :: Text -> r
state_after0 :: Text -> r
state_after0 !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
0) Text
bs
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> String -> r
err String
"Number literal with leading zero"
| Point
W8_DOT forall a. Eq a => a -> a -> Bool
== Point
w8 -> Integer -> Text -> r
go_dec Integer
0 Text
bs'
| Point
W8_e forall a. Eq a => a -> a -> Bool
== Point
w8 Bool -> Bool -> Bool
|| Point
W8_E forall a. Eq a => a -> a -> Bool
== Point
w8 -> Integer -> Int -> Text -> r
go_sci Integer
0 Int
0 Text
bs'
| Bool
otherwise -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
0) Text
bs
state_i1 :: Int -> Text -> r
state_i1 :: Int -> Text -> r
state_i1 !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
int) Text
bs
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Int -> Text -> r
state_i1 (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
| Point
W8_DOT forall a. Eq a => a -> a -> Bool
== Point
w8 -> Integer -> Text -> r
go_dec Integer
int Text
bs'
| Point
W8_e forall a. Eq a => a -> a -> Bool
== Point
w8 Bool -> Bool -> Bool
|| Point
W8_E forall a. Eq a => a -> a -> Bool
== Point
w8 -> Integer -> Int -> Text -> r
go_sci Integer
int Int
0 Text
bs'
| Bool
otherwise -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
int) Text
bs
where
int :: Integer
int = Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs0)
go_dec :: Integer -> Text -> r
go_dec :: Integer -> Text -> r
go_dec !Integer
int !Text
bs1 = case Text -> Maybe (Point, Text)
unconsPoint Text
bs1 of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Int -> Text -> r
state_dec Int
1 Text
bs'
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Point
w8
where
state_dec :: Int -> Text -> r
state_dec :: Int -> Text -> r
state_dec !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> Number -> Text -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) Text
bs
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Int -> Text -> r
state_dec (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
| Point
W8_e forall a. Eq a => a -> a -> Bool
== Point
w8 Bool -> Bool -> Bool
|| Point
W8_E forall a. Eq a => a -> a -> Bool
== Point
w8 -> Integer -> Int -> Text -> r
go_sci Integer
coef (forall a. Num a => a -> a
negate Int
n) Text
bs'
| Bool
otherwise -> Number -> Text -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) Text
bs
where
frac :: Integer
frac = Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
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 -> Text -> r
go_sci :: Integer -> Int -> Text -> r
go_sci !Integer
coef !Int
exp10 !Text
bs2 = case Text -> Maybe (Point, Text)
unconsPoint Text
bs2 of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
bs2 Int
1 Text
bs'
| Point
W8_PLUS forall a. Eq a => a -> a -> Bool
== Point
w8 -> case Text -> Maybe (Point, Text)
unconsPoint Text
bs' of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
w8', Text
bs'')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8', Point
w8' forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
bs' Int
1 Text
bs''
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Point
w8'
| Point
W8_MINUS forall a. Eq a => a -> a -> Bool
== Point
w8 -> case Text -> Maybe (Point, Text)
unconsPoint Text
bs' of
Maybe (Point, Text)
Nothing -> r
errEnd
Just (Point
w8', Text
bs'')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8', Point
w8' forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg Integer
coef Int
exp10 Text
bs' Int
1 Text
bs''
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Point
w8'
| Bool
otherwise -> forall {a}. Integral a => a -> r
errUnx Point
w8
go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos !Integer
coef !Int
exp10 !Text
bs2 !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
bs2 (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
| Bool
otherwise -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
where
exp10' :: Int
exp10' = forall a. Num a => Integer -> a
fromInteger (Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
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 -> Text -> Int -> Text -> r
go_sci_neg :: Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg !Integer
coef !Int
exp10 !Text
bs2 !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
Maybe (Point, Text)
Nothing -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
Just (Point
w8, Text
bs')
| Point
W8_0 forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 forall a. Ord a => a -> a -> Bool
<= Point
W8_9 -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg Integer
coef Int
exp10 Text
bs2 (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
| Bool
otherwise -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
where
exp10' :: Int
exp10' = forall a. Num a => Integer -> a
fromInteger (Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
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"
{-# INLINE unconsPoint #-}
unconsPoint :: Text -> Maybe (Point, Text)
unconsPoint :: Text -> Maybe (Point, Text)
unconsPoint (Text Array
arr Int
off Int
len)
| Int
len forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Point
w8, Array -> Int -> Int -> Text
Text Array
arr (Int
off forall a. Num a => a -> a -> a
+ Int
1) (Int
len forall a. Num a => a -> a -> a
- Int
1))
where
w8 :: Point
w8 = Array -> Int -> Point
A.unsafeIndex Array
arr Int
off
unsafeTakePoints :: Int -> Text -> Text
unsafeTakePoints :: Int -> Text -> Text
unsafeTakePoints Int
n (Text Array
arr Int
off Int
_len) = Array -> Int -> Int -> Text
Text Array
arr Int
off Int
n
{-# INLINE unsafeTakePoints #-}
unsafeDropPoints :: Int -> Text -> Text
unsafeDropPoints :: Int -> Text -> Text
unsafeDropPoints Int
n (Text Array
arr Int
off Int
len) = Array -> Int -> Int -> Text
Text Array
arr (Int
off forall a. Num a => a -> a -> a
+ Int
n) (Int
len forall a. Num a => a -> a -> a
- Int
n)
{-# INLINE unsafeDropPoints #-}