{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Scientific parsing from Text -- shamelessly copied from Aeson internals.

module Data.Hermes.Decoder.Internal.Scientific
  ( scanScientific
  ) where

import           Data.Integer.Conversion (textToInteger)
import           Data.Scientific         (Scientific)
import           Data.Text               (Text)

import qualified Data.Scientific         as Sci
import qualified Data.Text               as T

-- | Parse 'Scientific' number from 'Text'.
--
-- This is different from how JSON numbers are parsed: arbitrary leading zeroes
-- are accepted.
--
scanScientific
    :: forall r. (Scientific -> Text -> r)
    -> (String -> r)
    -> Text
    -> r
scanScientific :: forall r. (Scientific -> Text -> r) -> (String -> r) -> Text -> r
scanScientific Scientific -> Text -> r
kont String -> r
err Text
input0 = case Text -> Maybe (Char, Text)
T.uncons Text
input0 of
    Maybe (Char, Text)
Nothing -> r
errEnd
    Just (Char
c, Text
text')
        | Char
c forall a. Eq a => a -> a -> Bool
== Char
'+'  -> forall r. (Scientific -> Text -> r) -> (String -> r) -> Text -> r
scanScientific' Scientific -> Text -> r
kont String -> r
err Text
text'
        | Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'  -> forall r. (Scientific -> Text -> r) -> (String -> r) -> Text -> r
scanScientific' (\Scientific
sci -> Scientific -> Text -> r
kont (forall a. Num a => a -> a
negate Scientific
sci)) String -> r
err Text
text'
        | Bool
otherwise -> forall r. (Scientific -> Text -> r) -> (String -> r) -> Text -> r
scanScientific' Scientific -> Text -> r
kont String -> r
err Text
input0
  where
    errEnd :: r
errEnd = String -> r
err String
"Unexpected end-of-input while parsing number literal"

scanScientific'
    :: forall r. (Scientific -> Text -> r)
    -> (String -> r)
    -> Text
    -> r
scanScientific' :: forall r. (Scientific -> Text -> r) -> (String -> r) -> Text -> r
scanScientific' Scientific -> Text -> r
kont String -> r
err Text
input0 = Text -> r
state_start Text
input0 where
    state_start :: Text -> r
    state_start :: Text -> r
state_start !Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
        Maybe (Char, Text)
Nothing                      -> r
errEnd
        Just (Char
c, Text
text')
            | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'     -> Int -> Text -> r
state_i Int
1 Text
text'
            | 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 Char
c forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"

    state_i :: Int -> Text -> r
    state_i :: Int -> Text -> r
state_i !Int
n !Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
        Maybe (Char, Text)
Nothing                      -> Scientific -> Text -> r
kont (forall a. Num a => Integer -> a
fromInteger Integer
int) Text
text
        Just (Char
c, Text
text')
            | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'     -> Int -> Text -> r
state_i (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
text'
            | Char
'.' forall a. Eq a => a -> a -> Bool
== Char
c               -> Integer -> Text -> r
go_dec Integer
int Text
text'
            | Char
'e' forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
|| Char
'E' forall a. Eq a => a -> a -> Bool
== Char
c   -> Integer -> Int -> Text -> r
go_sci Integer
int Int
0 Text
text'
            | Bool
otherwise              -> Scientific -> Text -> r
kont (forall a. Num a => Integer -> a
fromInteger Integer
int) Text
text
      where
        int :: Integer
int = Text -> Integer
textToInteger (Int -> Text -> Text
T.take Int
n Text
input0)

    go_dec :: Integer -> Text -> r
    go_dec :: Integer -> Text -> r
go_dec !Integer
int !Text
text1 = case Text -> Maybe (Char, Text)
T.uncons Text
text1 of
        Maybe (Char, Text)
Nothing                       -> r
errEnd
        Just (Char
c, Text
text')
            | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'      -> Int -> Text -> r
state_dec Int
1 Text
text'
            | 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 Char
c forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"
      where
        state_dec :: Int -> Text -> r
        state_dec :: Int -> Text -> r
state_dec !Int
n !Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
            Maybe (Char, Text)
Nothing                      -> Scientific -> Text -> r
kont Scientific
dec Text
text
            Just (Char
c, Text
text')
                | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'     -> Int -> Text -> r
state_dec (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
text'
                | Char
'e' forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
|| Char
'E' forall a. Eq a => a -> a -> Bool
== Char
c   -> Integer -> Int -> Text -> r
go_sci Integer
coef (forall a. Num a => a -> a
negate Int
n) Text
text'
                | Bool
otherwise              -> Scientific -> Text -> r
kont Scientific
dec Text
text
          where
            frac :: Integer
frac = Text -> Integer
textToInteger (Int -> Text -> Text
T.take Int
n Text
text1)
            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
text2 = case Text -> Maybe (Char, Text)
T.uncons Text
text2 of
        Maybe (Char, Text)
Nothing                       -> r
errEnd
        Just (Char
c, Text
text')
            | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'      -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
text2 Int
1 Text
text'
            | Char
'+' forall a. Eq a => a -> a -> Bool
== Char
c                -> case Text -> Maybe (Char, Text)
T.uncons Text
text' of
                Maybe (Char, Text)
Nothing               -> r
errEnd
                Just (Char
c', Text
text'')
                    | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c', Char
c' forall a. Ord a => a -> a -> Bool
<= Char
'9'  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
text' Int
1 Text
text''
                    | Bool
otherwise       -> forall {a}. Show a => a -> r
errUnx Char
c'
            | Char
'-' forall a. Eq a => a -> a -> Bool
== Char
c                -> case Text -> Maybe (Char, Text)
T.uncons Text
text' of
                Maybe (Char, Text)
Nothing               -> r
errEnd
                Just (Char
c', Text
text'')
                    | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c', Char
c' forall a. Ord a => a -> a -> Bool
<= Char
'9'  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg Integer
coef Int
exp10 Text
text' Int
1 Text
text''
                    | Bool
otherwise       -> forall {a}. Show a => a -> r
errUnx Char
c'
            | Bool
otherwise               -> forall {a}. Show a => a -> r
errUnx Char
c

    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
text2 !Int
n !Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
        Maybe (Char, Text)
Nothing                       -> Scientific -> Text -> r
kont Scientific
sci Text
text
        Just (Char
c, Text
text')
            | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'      -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
text2 (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
text'
            | Bool
otherwise               -> Scientific -> Text -> r
kont Scientific
sci Text
text
      where
        exp10' :: Int
exp10' = forall a. Num a => Integer -> a
fromInteger (Text -> Integer
textToInteger (Int -> Text -> Text
T.take Int
n Text
text2))
        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
text2 !Int
n !Text
text = case Text -> Maybe (Char, Text)
T.uncons Text
text of
        Maybe (Char, Text)
Nothing                       -> Scientific -> Text -> r
kont Scientific
sci Text
text
        Just (Char
c, Text
text')
            | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg Integer
coef Int
exp10 Text
text2 (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
text'
            | Bool
otherwise               -> Scientific -> Text -> r
kont Scientific
sci Text
text
      where
        exp10' :: Int
exp10' = forall a. Num a => Integer -> a
fromInteger (Text -> Integer
textToInteger (Int -> Text -> Text
T.take Int
n Text
text2))
        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
c = String -> r
err forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
c forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"