{-# OPTIONS_GHC -Wno-unused-do-bind #-}
module Data.Aeson.JSONPath.Parser.Number
  ( pSignedInt
  , pScientific
  , pDoubleScientific
  )
  where

import qualified Text.ParserCombinators.Parsec  as P

import Data.Maybe                    (fromMaybe)
import Data.Scientific               (Scientific, scientific)
import GHC.Num                       (integerFromInt, integerToInt)

import Prelude

pSignedInt :: P.Parser Int
pSignedInt :: Parser Int
pSignedInt = do
  ParsecT String () Identity () -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"-0" ParsecT String () Identity String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.optional ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit) -- no leading -011... etc
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char   Char
'0' ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit) -- no leading 011... etc
  Maybe Char
sign <- ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (ParsecT String () Identity Char
 -> ParsecT String () Identity (Maybe Char))
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'-'
  Integer
num <- (String -> Integer
forall a. Read a => String -> a
read (String -> Integer)
-> ParsecT String () Identity String
-> ParsecT String () Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit) :: P.Parser Integer
  Integer -> Maybe Char -> Parser Int
forall {m :: * -> *} {a}.
MonadFail m =>
Integer -> Maybe a -> m Int
checkNumOutOfRange Integer
num Maybe Char
sign
  where
    minInt :: Integer
minInt = -Integer
9007199254740991
    maxInt :: Integer
maxInt = Integer
9007199254740991
    checkNumOutOfRange :: Integer -> Maybe a -> m Int
checkNumOutOfRange Integer
num (Just a
_) =
      if -Integer
num Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
minInt then String -> m Int
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"out of range"
      else Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerToInt (-Integer
num)

    checkNumOutOfRange Integer
num Maybe a
Nothing =
      if Integer
num Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxInt then String -> m Int
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"out of range"
      else Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
integerToInt Integer
num

-- TODO: Fix Double parse error  "1.12e+23"
pScientific :: P.Parser Scientific
pScientific :: Parser Scientific
pScientific = do
  Int
mantissa <- Parser Int
pSignedInt
  Maybe Int
expo <- Parser Int -> ParsecT String () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"eE" ParsecT String () Identity Char -> Parser Int -> Parser Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
pExponent)
  Scientific -> Parser Scientific
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Parser Scientific)
-> Scientific -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific (Int -> Integer
integerFromInt Int
mantissa) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
expo)

pDoubleScientific :: P.Parser Scientific
pDoubleScientific :: Parser Scientific
pDoubleScientific = do
  String
whole <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'.'
  String
frac <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  Maybe Int
expo <- Parser Int -> ParsecT String () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"eE" ParsecT String () Identity Char -> Parser Int -> Parser Int
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
pExponent)
  let num :: Scientific
num = String -> Scientific
forall a. Read a => String -> a
read (String
whole String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
frac String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Int
x -> String
"e" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x) Maybe Int
expo) :: Scientific
  Scientific -> Parser Scientific
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
num

pExponent :: P.Parser Int
pExponent :: Parser Int
pExponent = do
  Maybe Char
sign <- ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"+-")
  Int
num <- String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT String () Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  Int -> Parser Int
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ case Maybe Char
sign of
    Just Char
'-' -> -Int
num
    Maybe Char
_        -> Int
num