{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE TypeFamilies          #-}
-- | 
--
-- Representation of a JSON number and its various components.
--
module Waargonaut.Types.JNumber
  (
    -- * Types
    JNumber (..)
  , HasJNumber (..)
  , E (..)
  , AsE (..)
  , Frac (..)
  , Exp (..)
  , HasExp (..)
  , JInt
  , JInt' (..)

    -- * Prisms
  , _JZero
  , _JIntInt
  , _JNumberInt
  , _JNumberScientific

    -- * Parser
  , parseJNumber

    -- * Other
  , jNumberToScientific
  , jIntToDigits
  ) where

import           Prelude                 (Bool (..), Eq, Int, Integral, Ord,
                                          Show, abs, fromIntegral, maxBound,
                                          minBound, negate, (-), (<), (==), (>),
                                          (||))

import           Data.Scientific         (Scientific)
import qualified Data.Scientific         as Sci

import           Control.Category        (id, (.))
import           Control.Lens            (Lens', Prism', Rewrapped,
                                          Wrapped (..), iso, prism, ( # ), (^?),
                                          _Just, _Wrapped)

import           Control.Applicative     (pure, (*>), (<$), (<$>), (<*>))
import           Control.Monad           (Monad, (=<<))

import           Control.Error.Util      (note)

import           Data.Either             (Either (..))
import           Data.Function           (const, ($))
import           Data.Functor            (fmap)
import           Data.Maybe              (Maybe (..), fromMaybe, isJust, maybe)
import           Data.Semigroup          ((<>))
import           Data.Traversable        (traverse)
import           Data.Tuple              (uncurry)

import           Data.List.NonEmpty      (NonEmpty ((:|)), some1)
import qualified Data.List.NonEmpty      as NE

import           Data.Foldable           (asum, length)

import           Data.Digit              (DecDigit)
import qualified Data.Digit              as D

import           Text.Parser.Char        (CharParsing, char)
import           Text.Parser.Combinators (many, optional)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Monad (return)
-- >>> import Prelude (read)
-- >>> import Data.Either(Either (..), isLeft)
-- >>> import Data.List.NonEmpty (NonEmpty ((:|)))
-- >>> import Data.Digit (DecDigit(..))
-- >>> import qualified Data.Digit as D
-- >>> import Waargonaut.Decode.Error (DecodeError)
-- >>> import Data.ByteString.Lazy (toStrict)
-- >>> import Data.Text.Lazy.Builder (toLazyText)
-- >>> import Utils

-- | Represent a JSON "int"
data JInt' digit
  = JZero
  | JIntInt digit [DecDigit]
  deriving (JInt' digit -> JInt' digit -> Bool
(JInt' digit -> JInt' digit -> Bool)
-> (JInt' digit -> JInt' digit -> Bool) -> Eq (JInt' digit)
forall digit. Eq digit => JInt' digit -> JInt' digit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JInt' digit -> JInt' digit -> Bool
$c/= :: forall digit. Eq digit => JInt' digit -> JInt' digit -> Bool
== :: JInt' digit -> JInt' digit -> Bool
$c== :: forall digit. Eq digit => JInt' digit -> JInt' digit -> Bool
Eq, Eq (JInt' digit)
Eq (JInt' digit)
-> (JInt' digit -> JInt' digit -> Ordering)
-> (JInt' digit -> JInt' digit -> Bool)
-> (JInt' digit -> JInt' digit -> Bool)
-> (JInt' digit -> JInt' digit -> Bool)
-> (JInt' digit -> JInt' digit -> Bool)
-> (JInt' digit -> JInt' digit -> JInt' digit)
-> (JInt' digit -> JInt' digit -> JInt' digit)
-> Ord (JInt' digit)
JInt' digit -> JInt' digit -> Bool
JInt' digit -> JInt' digit -> Ordering
JInt' digit -> JInt' digit -> JInt' digit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall digit. Ord digit => Eq (JInt' digit)
forall digit. Ord digit => JInt' digit -> JInt' digit -> Bool
forall digit. Ord digit => JInt' digit -> JInt' digit -> Ordering
forall digit.
Ord digit =>
JInt' digit -> JInt' digit -> JInt' digit
min :: JInt' digit -> JInt' digit -> JInt' digit
$cmin :: forall digit.
Ord digit =>
JInt' digit -> JInt' digit -> JInt' digit
max :: JInt' digit -> JInt' digit -> JInt' digit
$cmax :: forall digit.
Ord digit =>
JInt' digit -> JInt' digit -> JInt' digit
>= :: JInt' digit -> JInt' digit -> Bool
$c>= :: forall digit. Ord digit => JInt' digit -> JInt' digit -> Bool
> :: JInt' digit -> JInt' digit -> Bool
$c> :: forall digit. Ord digit => JInt' digit -> JInt' digit -> Bool
<= :: JInt' digit -> JInt' digit -> Bool
$c<= :: forall digit. Ord digit => JInt' digit -> JInt' digit -> Bool
< :: JInt' digit -> JInt' digit -> Bool
$c< :: forall digit. Ord digit => JInt' digit -> JInt' digit -> Bool
compare :: JInt' digit -> JInt' digit -> Ordering
$ccompare :: forall digit. Ord digit => JInt' digit -> JInt' digit -> Ordering
$cp1Ord :: forall digit. Ord digit => Eq (JInt' digit)
Ord, Int -> JInt' digit -> ShowS
[JInt' digit] -> ShowS
JInt' digit -> String
(Int -> JInt' digit -> ShowS)
-> (JInt' digit -> String)
-> ([JInt' digit] -> ShowS)
-> Show (JInt' digit)
forall digit. Show digit => Int -> JInt' digit -> ShowS
forall digit. Show digit => [JInt' digit] -> ShowS
forall digit. Show digit => JInt' digit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JInt' digit] -> ShowS
$cshowList :: forall digit. Show digit => [JInt' digit] -> ShowS
show :: JInt' digit -> String
$cshow :: forall digit. Show digit => JInt' digit -> String
showsPrec :: Int -> JInt' digit -> ShowS
$cshowsPrec :: forall digit. Show digit => Int -> JInt' digit -> ShowS
Show)

-- | Type alias to allow us to constrain the first @digit@ type.
type JInt = JInt' DecDigit

-- | Prism for JSON zeroes.
_JZero :: Prism' JInt ()
_JZero :: p () (f ()) -> p JInt (f JInt)
_JZero = (() -> JInt) -> (JInt -> Either JInt ()) -> Prism JInt JInt () ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (JInt -> () -> JInt
forall a b. a -> b -> a
const JInt
forall digit. JInt' digit
JZero)
  (\case
      JInt
JZero -> () -> Either JInt ()
forall a b. b -> Either a b
Right ()
      JInt
x     -> JInt -> Either JInt ()
forall a b. a -> Either a b
Left JInt
x
  )

-- | Prism for JSON non-zero values.
_JIntInt :: Prism' (JInt' digit) (digit, [DecDigit])
_JIntInt :: p (digit, [DecDigit]) (f (digit, [DecDigit]))
-> p (JInt' digit) (f (JInt' digit))
_JIntInt = ((digit, [DecDigit]) -> JInt' digit)
-> (JInt' digit -> Either (JInt' digit) (digit, [DecDigit]))
-> Prism
     (JInt' digit) (JInt' digit) (digit, [DecDigit]) (digit, [DecDigit])
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((digit -> [DecDigit] -> JInt' digit)
-> (digit, [DecDigit]) -> JInt' digit
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry digit -> [DecDigit] -> JInt' digit
forall digit. digit -> [DecDigit] -> JInt' digit
JIntInt)
  (\case
      JIntInt digit
d [DecDigit]
ds -> (digit, [DecDigit]) -> Either (JInt' digit) (digit, [DecDigit])
forall a b. b -> Either a b
Right (digit
d,[DecDigit]
ds)
      JInt' digit
x -> JInt' digit -> Either (JInt' digit) (digit, [DecDigit])
forall a b. a -> Either a b
Left JInt' digit
x
  )
-- | The textual exponent character may be upper or lower case, we maintain this
-- fact using this type.
data E
  = EE
  | Ee
  deriving (E -> E -> Bool
(E -> E -> Bool) -> (E -> E -> Bool) -> Eq E
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: E -> E -> Bool
$c/= :: E -> E -> Bool
== :: E -> E -> Bool
$c== :: E -> E -> Bool
Eq, Eq E
Eq E
-> (E -> E -> Ordering)
-> (E -> E -> Bool)
-> (E -> E -> Bool)
-> (E -> E -> Bool)
-> (E -> E -> Bool)
-> (E -> E -> E)
-> (E -> E -> E)
-> Ord E
E -> E -> Bool
E -> E -> Ordering
E -> E -> E
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: E -> E -> E
$cmin :: E -> E -> E
max :: E -> E -> E
$cmax :: E -> E -> E
>= :: E -> E -> Bool
$c>= :: E -> E -> Bool
> :: E -> E -> Bool
$c> :: E -> E -> Bool
<= :: E -> E -> Bool
$c<= :: E -> E -> Bool
< :: E -> E -> Bool
$c< :: E -> E -> Bool
compare :: E -> E -> Ordering
$ccompare :: E -> E -> Ordering
$cp1Ord :: Eq E
Ord, Int -> E -> ShowS
[E] -> ShowS
E -> String
(Int -> E -> ShowS) -> (E -> String) -> ([E] -> ShowS) -> Show E
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [E] -> ShowS
$cshowList :: [E] -> ShowS
show :: E -> String
$cshow :: E -> String
showsPrec :: Int -> E -> ShowS
$cshowsPrec :: Int -> E -> ShowS
Show)

-- | Typeclass for things that may represent a upper or lower case exponent character.
class AsE r where
  _E  :: Prism' r E
  _EE :: Prism' r ()
  _Ee :: Prism' r ()
  _EE = p E (f E) -> p r (f r)
forall r. AsE r => Prism' r E
_E (p E (f E) -> p r (f r))
-> (p () (f ()) -> p E (f E)) -> p () (f ()) -> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p () (f ()) -> p E (f E)
forall r. AsE r => Prism' r ()
_EE
  _Ee = p E (f E) -> p r (f r)
forall r. AsE r => Prism' r E
_E (p E (f E) -> p r (f r))
-> (p () (f ()) -> p E (f E)) -> p () (f ()) -> p r (f r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p () (f ()) -> p E (f E)
forall r. AsE r => Prism' r ()
_Ee

instance AsE E where
  _E :: p E (f E) -> p E (f E)
_E = p E (f E) -> p E (f E)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  _EE :: p () (f ()) -> p E (f E)
_EE = (() -> E) -> (E -> Either E ()) -> Prism' E ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (E -> () -> E
forall a b. a -> b -> a
const E
EE)
    (\E
x -> case E
x of
        E
EE -> () -> Either E ()
forall a b. b -> Either a b
Right ()
        E
_  -> E -> Either E ()
forall a b. a -> Either a b
Left E
x
    )
  _Ee :: p () (f ()) -> p E (f E)
_Ee = (() -> E) -> (E -> Either E ()) -> Prism' E ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (E -> () -> E
forall a b. a -> b -> a
const E
Ee)
    (\E
x -> case E
x of
        E
Ee -> () -> Either E ()
forall a b. b -> Either a b
Right ()
        E
_  -> E -> Either E ()
forall a b. a -> Either a b
Left E
x
    )

-- | The fractional component of a JSON numeric value
newtype Frac = Frac (NonEmpty DecDigit)
  deriving (Frac -> Frac -> Bool
(Frac -> Frac -> Bool) -> (Frac -> Frac -> Bool) -> Eq Frac
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frac -> Frac -> Bool
$c/= :: Frac -> Frac -> Bool
== :: Frac -> Frac -> Bool
$c== :: Frac -> Frac -> Bool
Eq, Eq Frac
Eq Frac
-> (Frac -> Frac -> Ordering)
-> (Frac -> Frac -> Bool)
-> (Frac -> Frac -> Bool)
-> (Frac -> Frac -> Bool)
-> (Frac -> Frac -> Bool)
-> (Frac -> Frac -> Frac)
-> (Frac -> Frac -> Frac)
-> Ord Frac
Frac -> Frac -> Bool
Frac -> Frac -> Ordering
Frac -> Frac -> Frac
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Frac -> Frac -> Frac
$cmin :: Frac -> Frac -> Frac
max :: Frac -> Frac -> Frac
$cmax :: Frac -> Frac -> Frac
>= :: Frac -> Frac -> Bool
$c>= :: Frac -> Frac -> Bool
> :: Frac -> Frac -> Bool
$c> :: Frac -> Frac -> Bool
<= :: Frac -> Frac -> Bool
$c<= :: Frac -> Frac -> Bool
< :: Frac -> Frac -> Bool
$c< :: Frac -> Frac -> Bool
compare :: Frac -> Frac -> Ordering
$ccompare :: Frac -> Frac -> Ordering
$cp1Ord :: Eq Frac
Ord, Int -> Frac -> ShowS
[Frac] -> ShowS
Frac -> String
(Int -> Frac -> ShowS)
-> (Frac -> String) -> ([Frac] -> ShowS) -> Show Frac
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frac] -> ShowS
$cshowList :: [Frac] -> ShowS
show :: Frac -> String
$cshow :: Frac -> String
showsPrec :: Int -> Frac -> ShowS
$cshowsPrec :: Int -> Frac -> ShowS
Show)

instance Frac ~ t => Rewrapped Frac t
instance Wrapped Frac where
  type Unwrapped Frac = NonEmpty DecDigit
  _Wrapped' :: p (Unwrapped Frac) (f (Unwrapped Frac)) -> p Frac (f Frac)
_Wrapped' = (Frac -> NonEmpty DecDigit)
-> (NonEmpty DecDigit -> Frac)
-> Iso Frac Frac (NonEmpty DecDigit) (NonEmpty DecDigit)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (Frac NonEmpty DecDigit
x) -> NonEmpty DecDigit
x) NonEmpty DecDigit -> Frac
Frac

-- | The exponent part of a JSON numeric value
data Exp = Exp
  { Exp -> E
_ex        :: E
  , Exp -> Maybe Bool
_minusplus :: Maybe Bool
  , Exp -> NonEmpty DecDigit
_expdigits :: NonEmpty DecDigit
  }
  deriving (Exp -> Exp -> Bool
(Exp -> Exp -> Bool) -> (Exp -> Exp -> Bool) -> Eq Exp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exp -> Exp -> Bool
$c/= :: Exp -> Exp -> Bool
== :: Exp -> Exp -> Bool
$c== :: Exp -> Exp -> Bool
Eq, Eq Exp
Eq Exp
-> (Exp -> Exp -> Ordering)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Exp)
-> (Exp -> Exp -> Exp)
-> Ord Exp
Exp -> Exp -> Bool
Exp -> Exp -> Ordering
Exp -> Exp -> Exp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Exp -> Exp -> Exp
$cmin :: Exp -> Exp -> Exp
max :: Exp -> Exp -> Exp
$cmax :: Exp -> Exp -> Exp
>= :: Exp -> Exp -> Bool
$c>= :: Exp -> Exp -> Bool
> :: Exp -> Exp -> Bool
$c> :: Exp -> Exp -> Bool
<= :: Exp -> Exp -> Bool
$c<= :: Exp -> Exp -> Bool
< :: Exp -> Exp -> Bool
$c< :: Exp -> Exp -> Bool
compare :: Exp -> Exp -> Ordering
$ccompare :: Exp -> Exp -> Ordering
$cp1Ord :: Eq Exp
Ord, Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> String
(Int -> Exp -> ShowS)
-> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exp] -> ShowS
$cshowList :: [Exp] -> ShowS
show :: Exp -> String
$cshow :: Exp -> String
showsPrec :: Int -> Exp -> ShowS
$cshowsPrec :: Int -> Exp -> ShowS
Show)

-- | Typeclass for things that may have an 'Exp' component.
class HasExp c where
  exp :: Lens' c Exp
  ex :: Lens' c E
  {-# INLINE ex #-}
  expdigits :: Lens' c (NonEmpty DecDigit)
  {-# INLINE expdigits #-}
  minusplus :: Lens' c (Maybe Bool)
  {-# INLINE minusplus #-}
  ex = (Exp -> f Exp) -> c -> f c
forall c. HasExp c => Lens' c Exp
exp ((Exp -> f Exp) -> c -> f c)
-> ((E -> f E) -> Exp -> f Exp) -> (E -> f E) -> c -> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (E -> f E) -> Exp -> f Exp
forall c. HasExp c => Lens' c E
ex
  expdigits = (Exp -> f Exp) -> c -> f c
forall c. HasExp c => Lens' c Exp
exp ((Exp -> f Exp) -> c -> f c)
-> ((NonEmpty DecDigit -> f (NonEmpty DecDigit)) -> Exp -> f Exp)
-> (NonEmpty DecDigit -> f (NonEmpty DecDigit))
-> c
-> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (NonEmpty DecDigit -> f (NonEmpty DecDigit)) -> Exp -> f Exp
forall c. HasExp c => Lens' c (NonEmpty DecDigit)
expdigits
  minusplus = (Exp -> f Exp) -> c -> f c
forall c. HasExp c => Lens' c Exp
exp ((Exp -> f Exp) -> c -> f c)
-> ((Maybe Bool -> f (Maybe Bool)) -> Exp -> f Exp)
-> (Maybe Bool -> f (Maybe Bool))
-> c
-> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe Bool -> f (Maybe Bool)) -> Exp -> f Exp
forall c. HasExp c => Lens' c (Maybe Bool)
minusplus

instance HasExp Exp where
  {-# INLINE ex #-}
  {-# INLINE expdigits #-}
  {-# INLINE minusplus #-}
  exp :: (Exp -> f Exp) -> Exp -> f Exp
exp = (Exp -> f Exp) -> Exp -> f Exp
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  ex :: (E -> f E) -> Exp -> f Exp
ex E -> f E
f (Exp E
x1 Maybe Bool
x2 NonEmpty DecDigit
x3) = (E -> Exp) -> f E -> f Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ E
y1 -> E -> Maybe Bool -> NonEmpty DecDigit -> Exp
Exp E
y1 Maybe Bool
x2 NonEmpty DecDigit
x3) (E -> f E
f E
x1)
  expdigits :: (NonEmpty DecDigit -> f (NonEmpty DecDigit)) -> Exp -> f Exp
expdigits NonEmpty DecDigit -> f (NonEmpty DecDigit)
f (Exp E
x1 Maybe Bool
x2 NonEmpty DecDigit
x3) = (NonEmpty DecDigit -> Exp) -> f (NonEmpty DecDigit) -> f Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (E -> Maybe Bool -> NonEmpty DecDigit -> Exp
Exp E
x1 Maybe Bool
x2) (NonEmpty DecDigit -> f (NonEmpty DecDigit)
f NonEmpty DecDigit
x3)
  minusplus :: (Maybe Bool -> f (Maybe Bool)) -> Exp -> f Exp
minusplus Maybe Bool -> f (Maybe Bool)
f (Exp E
x1 Maybe Bool
x2 NonEmpty DecDigit
x3) = (Maybe Bool -> Exp) -> f (Maybe Bool) -> f Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Maybe Bool
y1 -> E -> Maybe Bool -> NonEmpty DecDigit -> Exp
Exp E
x1 Maybe Bool
y1 NonEmpty DecDigit
x3) (Maybe Bool -> f (Maybe Bool)
f Maybe Bool
x2)

-- | JSON Number type.
data JNumber = JNumber
  { JNumber -> Bool
_minus     :: Bool
  , JNumber -> JInt
_numberint :: JInt
  , JNumber -> Maybe Frac
_frac      :: Maybe Frac
  , JNumber -> Maybe Exp
_expn      :: Maybe Exp
  }
  deriving (JNumber -> JNumber -> Bool
(JNumber -> JNumber -> Bool)
-> (JNumber -> JNumber -> Bool) -> Eq JNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JNumber -> JNumber -> Bool
$c/= :: JNumber -> JNumber -> Bool
== :: JNumber -> JNumber -> Bool
$c== :: JNumber -> JNumber -> Bool
Eq, Eq JNumber
Eq JNumber
-> (JNumber -> JNumber -> Ordering)
-> (JNumber -> JNumber -> Bool)
-> (JNumber -> JNumber -> Bool)
-> (JNumber -> JNumber -> Bool)
-> (JNumber -> JNumber -> Bool)
-> (JNumber -> JNumber -> JNumber)
-> (JNumber -> JNumber -> JNumber)
-> Ord JNumber
JNumber -> JNumber -> Bool
JNumber -> JNumber -> Ordering
JNumber -> JNumber -> JNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JNumber -> JNumber -> JNumber
$cmin :: JNumber -> JNumber -> JNumber
max :: JNumber -> JNumber -> JNumber
$cmax :: JNumber -> JNumber -> JNumber
>= :: JNumber -> JNumber -> Bool
$c>= :: JNumber -> JNumber -> Bool
> :: JNumber -> JNumber -> Bool
$c> :: JNumber -> JNumber -> Bool
<= :: JNumber -> JNumber -> Bool
$c<= :: JNumber -> JNumber -> Bool
< :: JNumber -> JNumber -> Bool
$c< :: JNumber -> JNumber -> Bool
compare :: JNumber -> JNumber -> Ordering
$ccompare :: JNumber -> JNumber -> Ordering
$cp1Ord :: Eq JNumber
Ord, Int -> JNumber -> ShowS
[JNumber] -> ShowS
JNumber -> String
(Int -> JNumber -> ShowS)
-> (JNumber -> String) -> ([JNumber] -> ShowS) -> Show JNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JNumber] -> ShowS
$cshowList :: [JNumber] -> ShowS
show :: JNumber -> String
$cshow :: JNumber -> String
showsPrec :: Int -> JNumber -> ShowS
$cshowsPrec :: Int -> JNumber -> ShowS
Show)

-- | Typeclass for things that may have a 'JNumber'.
class HasJNumber c where
  jNumber   :: Lens' c JNumber
  expn      :: Lens' c (Maybe Exp)
  {-# INLINE expn #-}
  frac      :: Lens' c (Maybe Frac)
  {-# INLINE frac #-}
  minus     :: Lens' c Bool
  {-# INLINE minus #-}
  numberint :: Lens' c JInt
  {-# INLINE numberint #-}
  expn      = (JNumber -> f JNumber) -> c -> f c
forall c. HasJNumber c => Lens' c JNumber
jNumber ((JNumber -> f JNumber) -> c -> f c)
-> ((Maybe Exp -> f (Maybe Exp)) -> JNumber -> f JNumber)
-> (Maybe Exp -> f (Maybe Exp))
-> c
-> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe Exp -> f (Maybe Exp)) -> JNumber -> f JNumber
forall c. HasJNumber c => Lens' c (Maybe Exp)
expn
  frac      = (JNumber -> f JNumber) -> c -> f c
forall c. HasJNumber c => Lens' c JNumber
jNumber ((JNumber -> f JNumber) -> c -> f c)
-> ((Maybe Frac -> f (Maybe Frac)) -> JNumber -> f JNumber)
-> (Maybe Frac -> f (Maybe Frac))
-> c
-> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe Frac -> f (Maybe Frac)) -> JNumber -> f JNumber
forall c. HasJNumber c => Lens' c (Maybe Frac)
frac
  minus     = (JNumber -> f JNumber) -> c -> f c
forall c. HasJNumber c => Lens' c JNumber
jNumber ((JNumber -> f JNumber) -> c -> f c)
-> ((Bool -> f Bool) -> JNumber -> f JNumber)
-> (Bool -> f Bool)
-> c
-> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Bool -> f Bool) -> JNumber -> f JNumber
forall c. HasJNumber c => Lens' c Bool
minus
  numberint = (JNumber -> f JNumber) -> c -> f c
forall c. HasJNumber c => Lens' c JNumber
jNumber ((JNumber -> f JNumber) -> c -> f c)
-> ((JInt -> f JInt) -> JNumber -> f JNumber)
-> (JInt -> f JInt)
-> c
-> f c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JInt -> f JInt) -> JNumber -> f JNumber
forall c. HasJNumber c => Lens' c JInt
numberint

instance HasJNumber JNumber where
  {-# INLINE expn #-}
  {-# INLINE frac #-}
  {-# INLINE minus #-}
  {-# INLINE numberint #-}
  jNumber :: (JNumber -> f JNumber) -> JNumber -> f JNumber
jNumber = (JNumber -> f JNumber) -> JNumber -> f JNumber
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  expn :: (Maybe Exp -> f (Maybe Exp)) -> JNumber -> f JNumber
expn Maybe Exp -> f (Maybe Exp)
f (JNumber Bool
x1 JInt
x2 Maybe Frac
x3 Maybe Exp
x4)      = (Maybe Exp -> JNumber) -> f (Maybe Exp) -> f JNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
x1 JInt
x2 Maybe Frac
x3) (Maybe Exp -> f (Maybe Exp)
f Maybe Exp
x4)
  frac :: (Maybe Frac -> f (Maybe Frac)) -> JNumber -> f JNumber
frac Maybe Frac -> f (Maybe Frac)
f (JNumber Bool
x1 JInt
x2 Maybe Frac
x3 Maybe Exp
x4)      = (Maybe Frac -> JNumber) -> f (Maybe Frac) -> f JNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Maybe Frac
y1 -> Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
x1 JInt
x2 Maybe Frac
y1 Maybe Exp
x4) (Maybe Frac -> f (Maybe Frac)
f Maybe Frac
x3)
  minus :: (Bool -> f Bool) -> JNumber -> f JNumber
minus Bool -> f Bool
f (JNumber Bool
x1 JInt
x2 Maybe Frac
x3 Maybe Exp
x4)     = (Bool -> JNumber) -> f Bool -> f JNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Bool
y1 -> Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
y1 JInt
x2 Maybe Frac
x3 Maybe Exp
x4) (Bool -> f Bool
f Bool
x1)
  numberint :: (JInt -> f JInt) -> JNumber -> f JNumber
numberint JInt -> f JInt
f (JNumber Bool
x1 JInt
x2 Maybe Frac
x3 Maybe Exp
x4) = (JInt -> JNumber) -> f JInt -> f JNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ JInt
y1 -> Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
x1 JInt
y1 Maybe Frac
x3 Maybe Exp
x4) (JInt -> f JInt
f JInt
x2)

-- | Prism between a JNumber and a Haskell 'Int'. This prism will go via the
-- 'Scientific' type to handle the various exponent and fractional values before
-- attempting to convert it to a bounded integer.
_JNumberInt :: Prism' JNumber Int
_JNumberInt :: p Int (f Int) -> p JNumber (f JNumber)
_JNumberInt = (Int -> JNumber)
-> (JNumber -> Either JNumber Int) -> Prism JNumber JNumber Int Int
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Int -> JNumber
forall a. Integral a => a -> JNumber
jnumberToInt (\JNumber
v -> JNumber -> Maybe Int -> Either JNumber Int
forall a b. a -> Maybe b -> Either a b
note JNumber
v (Maybe Int -> Either JNumber Int)
-> Maybe Int -> Either JNumber Int
forall a b. (a -> b) -> a -> b
$ Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger (Scientific -> Maybe Int) -> Maybe Scientific -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JNumber -> Maybe Scientific
jNumberToScientific JNumber
v)
  where
    jnumberToInt :: a -> JNumber
jnumberToInt a
i = Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber (a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (a -> JInt
forall a. Integral a => a -> JInt
mkjInt (a -> JInt) -> a -> JInt
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
i) Maybe Frac
forall a. Maybe a
Nothing Maybe Exp
forall a. Maybe a
Nothing

mkjInt :: Integral a => a -> JInt' DecDigit
mkjInt :: a -> JInt
mkjInt a
0 = JInt
forall digit. JInt' digit
JZero
mkjInt a
n = (\(DecDigit
h :| [DecDigit]
t) -> DecDigit -> [DecDigit] -> JInt
forall digit. digit -> [DecDigit] -> JInt' digit
JIntInt DecDigit
h [DecDigit]
t) (NonEmpty DecDigit -> JInt) -> NonEmpty DecDigit -> JInt
forall a b. (a -> b) -> a -> b
$ Tagged Natural (Identity Natural)
-> Tagged (NonEmpty DecDigit) (Identity (NonEmpty DecDigit))
Prism' (NonEmpty DecDigit) Natural
D._NaturalDigits (Tagged Natural (Identity Natural)
 -> Tagged (NonEmpty DecDigit) (Identity (NonEmpty DecDigit)))
-> Natural -> NonEmpty DecDigit
forall t b. AReview t b -> b -> t
# a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n

-- | Prism for trying to move between 'JNumber' and 'Scientific'
--
-- >>> _JNumberScientific # (read "-3.45e-2")
-- JNumber {_minus = True, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (DecDigit4 :| [DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = DecDigit2 :| []})}
--
-- >>> _JNumberScientific # (read "-1.23456e-787")
-- JNumber {_minus = True, _numberint = JIntInt DecDigit1 [], _frac = Just (Frac (DecDigit2 :| [DecDigit3,DecDigit4,DecDigit5,DecDigit6])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = DecDigit7 :| [DecDigit8,DecDigit7]})}
--
-- >>> _JNumberScientific # (read "-1.23456e791")
-- JNumber {_minus = True, _numberint = JIntInt DecDigit1 [], _frac = Just (Frac (DecDigit2 :| [DecDigit3,DecDigit4,DecDigit5,DecDigit6])), _expn = Just (Exp {_ex = Ee, _minusplus = Just False, _expdigits = DecDigit7 :| [DecDigit9,DecDigit1]})}
--
_JNumberScientific :: Prism' JNumber Scientific
_JNumberScientific :: p Scientific (f Scientific) -> p JNumber (f JNumber)
_JNumberScientific = (Scientific -> JNumber)
-> (JNumber -> Either JNumber Scientific)
-> Prism JNumber JNumber Scientific Scientific
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Scientific -> JNumber
toJNum (\JNumber
v -> JNumber -> Maybe Scientific -> Either JNumber Scientific
forall a b. a -> Maybe b -> Either a b
note JNumber
v (Maybe Scientific -> Either JNumber Scientific)
-> Maybe Scientific -> Either JNumber Scientific
forall a b. (a -> b) -> a -> b
$ JNumber -> Maybe Scientific
jNumberToScientific JNumber
v)
  where
    toJNum :: Scientific -> JNumber
toJNum Scientific
s =
      let ([Int]
is, Int
e) = Scientific -> ([Int], Int)
Sci.toDecimalDigits (Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
s)
          sign :: Bool
sign = Scientific
s Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0

          mkNum :: JInt -> [Int] -> JNumber
mkNum JInt
hdD [Int]
tlD = Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
sign JInt
hdD ((NonEmpty DecDigit -> Frac)
-> Maybe (NonEmpty DecDigit) -> Maybe Frac
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty DecDigit -> Frac
Frac (Maybe (NonEmpty DecDigit) -> Maybe Frac)
-> Maybe (NonEmpty DecDigit) -> Maybe Frac
forall a b. (a -> b) -> a -> b
$ [DecDigit] -> Maybe (NonEmpty DecDigit)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([DecDigit] -> Maybe (NonEmpty DecDigit))
-> Maybe [DecDigit] -> Maybe (NonEmpty DecDigit)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> Maybe DecDigit) -> [Int] -> Maybe [DecDigit]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Int -> Getting (First DecDigit) Int DecDigit -> Maybe DecDigit
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First DecDigit) Int DecDigit
forall a d. (Integral a, Decimal d) => Prism' a d
D.integralDecimal) [Int]
tlD) (Int -> Maybe Exp
forall a. Integral a => a -> Maybe Exp
ex' Int
e)
          mkExp :: Bool -> a -> Maybe Exp
mkExp Bool
isNeg a
expN = Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ E -> Maybe Bool -> NonEmpty DecDigit -> Exp
Exp E
Ee (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
isNeg) (Tagged Natural (Identity Natural)
-> Tagged (NonEmpty DecDigit) (Identity (NonEmpty DecDigit))
Prism' (NonEmpty DecDigit) Natural
D._NaturalDigits (Tagged Natural (Identity Natural)
 -> Tagged (NonEmpty DecDigit) (Identity (NonEmpty DecDigit)))
-> Natural -> NonEmpty DecDigit
forall t b. AReview t b -> b -> t
# a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
expN)

          ex' :: a -> Maybe Exp
ex' a
0  = Maybe Exp
forall a. Maybe a
Nothing
          ex' a
e' = Bool -> a -> Maybe Exp
forall a. Integral a => Bool -> a -> Maybe Exp
mkExp (a
e' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (a -> a
forall a. Num a => a -> a
abs (a
e' a -> a -> a
forall a. Num a => a -> a -> a
- a
1))

      in case [Int]
is of
        []     -> Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
sign JInt
forall digit. JInt' digit
JZero Maybe Frac
forall a. Maybe a
Nothing Maybe Exp
forall a. Maybe a
Nothing
        [Int
0]    -> Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
sign JInt
forall digit. JInt' digit
JZero Maybe Frac
forall a. Maybe a
Nothing Maybe Exp
forall a. Maybe a
Nothing
        [Int
d]    -> Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber Bool
sign (Int -> JInt
forall a. Integral a => a -> JInt
mkjInt Int
d) Maybe Frac
forall a. Maybe a
Nothing (Int -> Maybe Exp
forall a. Integral a => a -> Maybe Exp
ex' Int
e)
        (Int
d:[Int]
ds) -> if Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then JInt -> [Int] -> JNumber
mkNum JInt
forall digit. JInt' digit
JZero [Int]
is else JInt -> [Int] -> JNumber
mkNum (Int -> JInt
forall a. Integral a => a -> JInt
mkjInt Int
d) [Int]
ds

-- | Parse the integer component of a JSON number.
--
-- >>> testparse parseJInt "1"
-- Right (JIntInt DecDigit1 [])
--
-- >>> testparse parseJInt "9"
-- Right (JIntInt DecDigit9 [])
--
-- >>> testparse parseJInt "10"
-- Right (JIntInt DecDigit1 [DecDigit0])
--
-- >>> testparse parseJInt "39"
-- Right (JIntInt DecDigit3 [DecDigit9])
--
-- >>> testparse parseJInt "393564"
-- Right (JIntInt DecDigit3 [DecDigit9,DecDigit3,DecDigit5,DecDigit6,DecDigit4])
--
-- >>> testparse parseJInt "0"
-- Right JZero
--
-- >>> testparsethennoteof parseJInt "00"
-- Right JZero
--
-- >>> testparsethennoteof parseJInt "01"
-- Right JZero
--
-- >>> testparsetheneof parseJInt "1"
-- Right (JIntInt DecDigit1 [])
--
-- >>> testparsetheneof parseJInt "9"
-- Right (JIntInt DecDigit9 [])
--
-- >>> testparsetheneof parseJInt "10"
-- Right (JIntInt DecDigit1 [DecDigit0])
--
-- >>> testparsetheneof parseJInt "39"
-- Right (JIntInt DecDigit3 [DecDigit9])
--
-- >>> testparsetheneof parseJInt "393564"
-- Right (JIntInt DecDigit3 [DecDigit9,DecDigit3,DecDigit5,DecDigit6,DecDigit4])
--
-- >>> testparsetheneof parseJInt "0"
-- Right JZero
--
-- >>> isLeft (testparse parseJInt "x")
-- True
--
-- >>> isLeft (testparse parseJInt "")
-- True
parseJInt ::
  (Monad f, CharParsing f) =>
  f JInt
parseJInt :: f JInt
parseJInt =
  [f JInt] -> f JInt
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
    JInt
forall digit. JInt' digit
JZero JInt -> f Char -> f JInt
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'0'
  , DecDigit -> [DecDigit] -> JInt
forall digit. digit -> [DecDigit] -> JInt' digit
JIntInt (DecDigit -> [DecDigit] -> JInt)
-> f DecDigit -> f ([DecDigit] -> JInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f DecDigit
forall d (p :: * -> *). (DecimalNoZero d, CharParsing p) => p d
D.parseDecimalNoZero f ([DecDigit] -> JInt) -> f [DecDigit] -> f JInt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f DecDigit -> f [DecDigit]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many f DecDigit
forall d (p :: * -> *). (Decimal d, CharParsing p) => p d
D.parseDecimal
  ]

-- | Parse the exponent portion of a JSON number.
--
-- >>> testparse parseE "e"
-- Right Ee
--
-- >>> testparse parseE "E"
-- Right EE
--
-- >>> testparsetheneof parseE "e"
-- Right Ee
--
-- >>> testparsetheneof parseE "E"
-- Right EE
--
-- >>> isLeft (testparsetheneof parseE "x")
-- True
--
-- >>> testparsethennoteof parseE "ea"
-- Right Ee
--
-- >>> testparsethennoteof parseE "Ea"
-- Right EE
parseE ::
  CharParsing f =>
  f E
parseE :: f E
parseE =
  [f E] -> f E
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
    E
Ee E -> f Char -> f E
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'e'
  , E
EE E -> f Char -> f E
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'E'
  ]

-- | Parse the fractional component of a JSON number.
--
-- >>> testparsetheneof parseFrac "1"
-- Right (Frac (DecDigit1 :| []))
--
-- >>> testparsetheneof parseFrac "9"
-- Right (Frac (DecDigit9 :| []))
--
-- >>> testparsetheneof parseFrac "10"
-- Right (Frac (DecDigit1 :| [DecDigit0]))
--
-- >>> testparsetheneof parseFrac "39"
-- Right (Frac (DecDigit3 :| [DecDigit9]))
--
-- >>> testparsetheneof parseFrac "393564"
-- Right (Frac (DecDigit3 :| [DecDigit9,DecDigit3,DecDigit5,DecDigit6,DecDigit4]))
--
-- >>> testparsetheneof parseFrac "0"
-- Right (Frac (DecDigit0 :| []))
--
-- >>> testparsetheneof parseFrac "00"
-- Right (Frac (DecDigit0 :| [DecDigit0]))
--
-- >>> testparsetheneof parseFrac "01"
-- Right (Frac (DecDigit0 :| [DecDigit1]))
--
-- >>> testparsethennoteof parseFrac "01x"
-- Right (Frac (DecDigit0 :| [DecDigit1]))
parseFrac ::
  (Monad f, CharParsing f) =>
  f Frac
parseFrac :: f Frac
parseFrac =
  NonEmpty DecDigit -> Frac
Frac (NonEmpty DecDigit -> Frac) -> f (NonEmpty DecDigit) -> f Frac
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f DecDigit -> f (NonEmpty DecDigit)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 f DecDigit
forall d (p :: * -> *). (Decimal d, CharParsing p) => p d
D.parseDecimal

-- | Parse the full exponent portion of a JSON number.
--
-- >>> testparsethen parseExp "e10x"
-- Right (Exp {_ex = Ee, _minusplus = Nothing, _expdigits = DecDigit1 :| [DecDigit0]},'x')
--
-- >>> testparsethen parseExp "e+10x"
-- Right (Exp {_ex = Ee, _minusplus = Just False, _expdigits = DecDigit1 :| [DecDigit0]},'x')
--
-- >>> testparsethen parseExp "e-0x"
-- Right (Exp {_ex = Ee, _minusplus = Just True, _expdigits = DecDigit0 :| []},'x')
--
-- >>> testparsethen parseExp "E-1x"
-- Right (Exp {_ex = EE, _minusplus = Just True, _expdigits = DecDigit1 :| []},'x')
parseExp ::
  (Monad f, CharParsing f) =>
  f Exp
parseExp :: f Exp
parseExp = E -> Maybe Bool -> NonEmpty DecDigit -> Exp
Exp
  (E -> Maybe Bool -> NonEmpty DecDigit -> Exp)
-> f E -> f (Maybe Bool -> NonEmpty DecDigit -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f E
forall (f :: * -> *). CharParsing f => f E
parseE
  f (Maybe Bool -> NonEmpty DecDigit -> Exp)
-> f (Maybe Bool) -> f (NonEmpty DecDigit -> Exp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Bool -> f (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([f Bool] -> f Bool
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Bool
False Bool -> f Char -> f Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'+', Bool
True Bool -> f Char -> f Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'-'])
  f (NonEmpty DecDigit -> Exp) -> f (NonEmpty DecDigit) -> f Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f DecDigit -> f (NonEmpty DecDigit)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 f DecDigit
forall d (p :: * -> *). (Decimal d, CharParsing p) => p d
D.parseDecimal

-- | Parse a JSON numeric value.
--
-- >>> testparsethen parseJNumber "600x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit6 [DecDigit0,DecDigit0], _frac = Nothing, _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "800x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit8 [DecDigit0,DecDigit0], _frac = Nothing, _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "3x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit3 [], _frac = Nothing, _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "-3x"
-- Right (JNumber {_minus = True, _numberint = JIntInt DecDigit3 [], _frac = Nothing, _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "0x"
-- Right (JNumber {_minus = False, _numberint = JZero, _frac = Nothing, _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "-0x"
-- Right (JNumber {_minus = True, _numberint = JZero, _frac = Nothing, _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "3.45x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (DecDigit4 :| [DecDigit5])), _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "-3.45x"
-- Right (JNumber {_minus = True, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (DecDigit4 :| [DecDigit5])), _expn = Nothing},'x')
--
-- >>> testparsethen parseJNumber "3.45e10x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (DecDigit4 :| [DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Nothing, _expdigits = DecDigit1 :| [DecDigit0]})},'x')
--
-- >>> testparsethen parseJNumber "3e10x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit3 [], _frac = Nothing, _expn = Just (Exp {_ex = Ee, _minusplus = Nothing, _expdigits = DecDigit1 :| [DecDigit0]})},'x')
--
-- >>> testparsethen parseJNumber "3.45e+10x"
-- Right (JNumber {_minus = False, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (DecDigit4 :| [DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just False, _expdigits = DecDigit1 :| [DecDigit0]})},'x')
--
-- >>> testparsethen parseJNumber "-3.45e-02x"
-- Right (JNumber {_minus = True, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (DecDigit4 :| [DecDigit5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = DecDigit0 :| [DecDigit2]})},'x')
--
-- >>> isLeft (testparsethen parseJNumber "-3.45ex")
-- True
--
-- >>> isLeft (testparsethen parseJNumber "-.45e1x")
-- True
parseJNumber ::
  (Monad f, CharParsing f) =>
  f JNumber
parseJNumber :: f JNumber
parseJNumber = Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber
JNumber
  (Bool -> JInt -> Maybe Frac -> Maybe Exp -> JNumber)
-> (Maybe Char -> Bool)
-> Maybe Char
-> JInt
-> Maybe Frac
-> Maybe Exp
-> JNumber
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> JInt -> Maybe Frac -> Maybe Exp -> JNumber)
-> f (Maybe Char) -> f (JInt -> Maybe Frac -> Maybe Exp -> JNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Char -> f (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'-')
  f (JInt -> Maybe Frac -> Maybe Exp -> JNumber)
-> f JInt -> f (Maybe Frac -> Maybe Exp -> JNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f JInt
forall (f :: * -> *). (Monad f, CharParsing f) => f JInt
parseJInt
  f (Maybe Frac -> Maybe Exp -> JNumber)
-> f (Maybe Frac) -> f (Maybe Exp -> JNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Frac -> f (Maybe Frac)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> f Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.' f Char -> f Frac -> f Frac
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f Frac
forall (f :: * -> *). (Monad f, CharParsing f) => f Frac
parseFrac)
  f (Maybe Exp -> JNumber) -> f (Maybe Exp) -> f JNumber
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Exp -> f (Maybe Exp)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional f Exp
forall (f :: * -> *). (Monad f, CharParsing f) => f Exp
parseExp

-- | Returns a normalised 'Scientific' value or Nothing if the exponent
--   is out of the range @[minBound,maxBound::Int]@
--
-- >>> jNumberToScientific JNumber {_minus = True, _numberint = JIntInt DecDigit3 [], _frac = Just (Frac (D.x4 :| [D.x5])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = D.x0 :| [D.x2]})}
-- Just -3.45e-2
--
-- >>> jNumberToScientific JNumber {_minus = True, _numberint = JIntInt D.x1 [D.x2, D.x3], _frac = Just (Frac (D.x4 :| [D.x5, D.x6])), _expn = Just (Exp {_ex = Ee, _minusplus = Just True, _expdigits = (D.x7 :| [D.x8, D.x9])})}
-- Just -1.23456e-787
--
-- >>> jNumberToScientific JNumber {_minus = True, _numberint = JIntInt D.x1 [D.x2, D.x3], _frac = Just (Frac (D.x4 :| [D.x5, D.x6])), _expn = Just (Exp {_ex = Ee, _minusplus = Just False, _expdigits = (D.x7 :| [D.x8, D.x9])})}
-- Just -1.23456e791
--
jNumberToScientific :: JNumber -> Maybe Scientific
jNumberToScientific :: JNumber -> Maybe Scientific
jNumberToScientific (JNumber Bool
sign JInt
int Maybe Frac
mfrac Maybe Exp
mexp) =
  if Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int) Bool -> Bool -> Bool
||
     Int
expon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int)
  then Maybe Scientific
forall a. Maybe a
Nothing
  else Integer -> Int -> Scientific
Sci.scientific (Integer -> Int -> Scientific)
-> Maybe Integer -> Maybe (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
coeff Maybe (Int -> Scientific) -> Maybe Int -> Maybe Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Maybe Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
expon
  where
    natToNeg :: Maybe Bool -> f a -> f b
natToNeg Maybe Bool
s = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( Maybe Bool -> b -> b
forall a. Num a => Maybe Bool -> a -> a
neg Maybe Bool
s (b -> b) -> (a -> b) -> a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral )

    intDigs :: NonEmpty DecDigit
intDigs       = JInt -> NonEmpty DecDigit
jIntToDigits JInt
int

    fracList :: Maybe (NonEmpty DecDigit)
fracList      = Maybe Frac
mfrac Maybe Frac
-> Getting
     (First (NonEmpty DecDigit)) (Maybe Frac) (NonEmpty DecDigit)
-> Maybe (NonEmpty DecDigit)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Frac -> Const (First (NonEmpty DecDigit)) Frac)
-> Maybe Frac -> Const (First (NonEmpty DecDigit)) (Maybe Frac)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Frac -> Const (First (NonEmpty DecDigit)) Frac)
 -> Maybe Frac -> Const (First (NonEmpty DecDigit)) (Maybe Frac))
-> ((NonEmpty DecDigit
     -> Const (First (NonEmpty DecDigit)) (NonEmpty DecDigit))
    -> Frac -> Const (First (NonEmpty DecDigit)) Frac)
-> Getting
     (First (NonEmpty DecDigit)) (Maybe Frac) (NonEmpty DecDigit)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (NonEmpty DecDigit
 -> Const (First (NonEmpty DecDigit)) (NonEmpty DecDigit))
-> Frac -> Const (First (NonEmpty DecDigit)) Frac
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped
    exponentShift :: Int
exponentShift = Int
-> (NonEmpty DecDigit -> Int) -> Maybe (NonEmpty DecDigit) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty DecDigit -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe (NonEmpty DecDigit)
fracList

    coeff :: Maybe Integer
coeff         = Maybe Bool -> Maybe Natural -> Maybe Integer
forall (f :: * -> *) a b.
(Functor f, Integral a, Num b) =>
Maybe Bool -> f a -> f b
natToNeg
                      (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
sign)
                      (NonEmpty DecDigit -> Maybe Natural
D.digitsToNatural (NonEmpty DecDigit -> Maybe Natural)
-> NonEmpty DecDigit -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ NonEmpty DecDigit
-> (NonEmpty DecDigit -> NonEmpty DecDigit)
-> Maybe (NonEmpty DecDigit)
-> NonEmpty DecDigit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonEmpty DecDigit
intDigs (NonEmpty DecDigit
intDigs NonEmpty DecDigit -> NonEmpty DecDigit -> NonEmpty DecDigit
forall a. Semigroup a => a -> a -> a
<>) Maybe (NonEmpty DecDigit)
fracList)

    expon :: Int
expon         = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ( Exp -> Maybe Int
forall b. Num b => Exp -> Maybe b
expval (Exp -> Maybe Int) -> Maybe Exp -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Exp
mexp ) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
exponentShift

    neg :: Maybe Bool -> a -> a
neg (Just Bool
True) = a -> a
forall a. Num a => a -> a
negate
    neg Maybe Bool
_           = a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

    expval :: Exp -> Maybe b
expval (Exp E
_ Maybe Bool
msign NonEmpty DecDigit
digs) = Maybe Bool -> Maybe Natural -> Maybe b
forall (f :: * -> *) a b.
(Functor f, Integral a, Num b) =>
Maybe Bool -> f a -> f b
natToNeg Maybe Bool
msign (NonEmpty DecDigit -> Maybe Natural
D.digitsToNatural NonEmpty DecDigit
digs)

-- | Helper to convert a 'JInt' to a 'NonEmpty' list of component digits.
jIntToDigits :: JInt -> NonEmpty DecDigit
jIntToDigits :: JInt -> NonEmpty DecDigit
jIntToDigits JInt
JZero          = DecDigit
forall d. D0 d => d
D.x0 DecDigit -> [DecDigit] -> NonEmpty DecDigit
forall a. a -> [a] -> NonEmpty a
NE.:| []
jIntToDigits (JIntInt DecDigit
d [DecDigit]
ds) = DecDigit
d DecDigit -> [DecDigit] -> NonEmpty DecDigit
forall a. a -> [a] -> NonEmpty a
NE.:| [DecDigit]
ds