Number.hs

-- | Shared ProtoJSON numeric parsing for runtime helpers and generated codecs.
module Proto.Internal.JSON.Number (numericString, floating) where

import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Char (isSpace)
import Data.Scientific (Scientific, toRealFloat)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE


{- | Use JSON's full numeric grammar, including signed e/E exponents, with
complete consumption. Whitespace inside a quoted number is not permitted.
-}
numericString :: Text -> Aeson.Parser Scientific
numericString t
  | T.null t || T.any isSpace t = fail "Invalid numeric string (empty or whitespace)"
  | otherwise = case Aeson.eitherDecodeStrict' (TE.encodeUtf8 t) of
      Right (Aeson.Number n) -> pure n
      _ -> fail "Invalid numeric string"


floating :: forall a. RealFloat a => Aeson.Value -> Aeson.Parser a
floating = \case
  Aeson.Number n -> finite n
  Aeson.String "NaN" -> pure (0 / 0)
  Aeson.String "Infinity" -> pure (1 / 0)
  Aeson.String "-Infinity" -> pure (negate (1 / 0))
  Aeson.String t -> numericString t >>= finite
  _ -> fail "Expected JSON number or numeric string"
  where
    finite n =
      let value = toRealFloat n :: a
      in if isInfinite value
           then fail "float/double overflow"
           else pure value