{-# 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
  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
'-'
  num <- (read <$> P.many1 P.digit) :: P.Parser Integer
  checkNumOutOfRange num 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
  mantissa <- Parser Int
pSignedInt
  expo <- P.optionMaybe (P.oneOf "eE" *> pExponent)
  return $ scientific (integerFromInt mantissa) (fromMaybe 0 expo)

pDoubleScientific :: P.Parser Scientific
pDoubleScientific :: Parser Scientific
pDoubleScientific = do
  whole <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. 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.char '.'
  frac <- P.many1 P.digit
  expo <- P.optionMaybe (P.oneOf "eE" *> pExponent)
  let 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
  return num

pExponent :: P.Parser Int
pExponent :: Parser Int
pExponent = do
  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
"+-")
  num <- read <$> P.many1 P.digit
  return $ case sign of
    Just Char
'-' -> -Int
num
    Maybe Char
_        -> Int
num