{-# LANGUAGE Safe #-}
{-# LANGUAGE DataKinds, ConstraintKinds, MultiParamTypeClasses, AllowAmbiguousTypes, FlexibleInstances, FlexibleContexts, UndecidableInstances, ApplicativeDo, TypeFamilies, TypeOperators, CPP #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.Gigaparsec.Internal.Token.Numeric (module Text.Gigaparsec.Internal.Token.Numeric) where

import Text.Gigaparsec (Parsec, unit, void, atomic, (<|>), ($>))
import Text.Gigaparsec.Char (char, oneOf)
import Text.Gigaparsec.Combinator (optional, optionalAs)
import Text.Gigaparsec.Errors.Combinator (mapMaybeSWith)
import Text.Gigaparsec.Errors.ErrorGen (specializedGen, messages)
import Text.Gigaparsec.Token.Descriptions
    ( BreakCharDesc(BreakCharSupported, NoBreakChar),
      NumericDesc( NumericDesc, positiveSign, literalBreakChar
                 , integerNumbersCanBeHexadecimal, integerNumbersCanBeOctal
                 , integerNumbersCanBeBinary
                 , hexadecimalLeads, octalLeads, binaryLeads
                 ),
      PlusSignPresence(PlusIllegal, PlusRequired, PlusOptional) )
import Text.Gigaparsec.Internal.Token.Generic (GenericNumeric(plainDecimal, plainHexadecimal, plainOctal, plainBinary))
import Data.Char (intToDigit)
import Data.Kind (Constraint)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Data.Proxy (Proxy(Proxy))
import Control.Monad (when, unless)
import Numeric (showIntAtBase)

#if __GLASGOW_HASKELL__ >= 904

import GHC.TypeLits (type (<=?), Nat)
import GHC.TypeError (TypeError, ErrorMessage(Text, (:<>:), ShowType), Assert)

#else

import GHC.TypeLits (type (<=?), Nat, TypeError, ErrorMessage(Text, (:<>:), ShowType))

type Assert :: Bool -> Constraint -> Constraint
type family Assert b c where
  Assert 'True  _ = ()
  Assert 'False c = c

#endif

type Bits :: *
data Bits = B8 | B16 | B32 | B64

type BitWidth :: * -> Bits
type family BitWidth t where
  BitWidth Integer = 'B64
  BitWidth Int     = 'B64
  BitWidth Word    = 'B64
  BitWidth Word64  = 'B64
  BitWidth Natural = 'B64
  BitWidth Int32   = 'B32
  BitWidth Word32  = 'B32
  BitWidth Int16   = 'B16
  BitWidth Word16  = 'B16
  BitWidth Int8    = 'B8
  BitWidth Word8   = 'B8
  BitWidth t       = TypeError ('Text "The type '" ' :<>: 'ShowType t
                          ':<>: 'Text "' is not a numeric type supported by Gigaparsec")

type SignednessK :: *
data SignednessK = Signed | Unsigned

type Signedness :: * -> SignednessK -> Constraint
type family Signedness t s where
  Signedness Integer _         = () -- integers are allowed to serve as both unsigned and signed
  Signedness Int     'Signed   = ()
  Signedness Word    'Unsigned = ()
  Signedness Word64  'Unsigned = ()
  Signedness Natural 'Unsigned = ()
  Signedness Int32   'Signed   = ()
  Signedness Word32  'Unsigned = ()
  Signedness Int16   'Signed   = ()
  Signedness Word16  'Unsigned = ()
  Signedness Int8    'Signed   = ()
  Signedness Word8   'Unsigned = ()
  Signedness t       'Signed   = TypeError ('Text "The type '" ':<>: 'ShowType t
                                      ':<>: 'Text "' does not hold signed numbers")
  Signedness t       'Unsigned = TypeError ('Text "The type '" ' :<>: 'ShowType t
                                      ':<>: 'Text "' does not hold unsigned numbers")

type ShowBits :: Bits -> ErrorMessage
type ShowBits b = 'ShowType (BitsNat b)

-- This is intentionally not a type alias. On GHC versions < 9.4.1 it appears that TypeErrors are
-- reported slightly more eagerly and we get an error on this definition because
-- > BitsNat b <=? BitsNat (BitWidth t)
-- cannot be solved
type HasWidthFor :: Bits -> * -> Constraint
type family HasWidthFor bits t where
  HasWidthFor bits t = Assert (BitsNat bits <=? BitsNat (BitWidth t))
                              (TypeError ('Text "The type '"
                                    ':<>: 'ShowType t  ' :<>: 'Text "' cannot store a "
                                    ':<>: ShowBits bits ' :<>: 'Text " bit number (only supports up to "
                                    ':<>: ShowBits (BitWidth t) ' :<>: 'Text " bits)."))

type BitBounds :: Bits -> Constraint
class BitBounds b where
  upperSigned :: Integer
  lowerSigned :: Integer
  upperUnsigned :: Integer
  bits :: Int
  type BitsNat b :: Nat
instance BitBounds 'B8 where
  upperSigned :: Integer
upperSigned = Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Int8)
  lowerSigned :: Integer
lowerSigned = Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Int8)
  upperUnsigned :: Integer
upperUnsigned = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word8)
  bits :: Int
bits = Int
8
  type BitsNat 'B8 = 8
instance BitBounds 'B16 where
  upperSigned :: Integer
upperSigned = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Int16)
  lowerSigned :: Integer
lowerSigned = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Int16)
  upperUnsigned :: Integer
upperUnsigned = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word16)
  bits :: Int
bits = Int
16
  type BitsNat 'B16 = 16
instance BitBounds 'B32 where
  upperSigned :: Integer
upperSigned = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Int32)
  lowerSigned :: Integer
lowerSigned = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Int32)
  upperUnsigned :: Integer
upperUnsigned = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word32)
  bits :: Int
bits = Int
32
  type BitsNat 'B32 = 32
instance BitBounds 'B64 where
  upperSigned :: Integer
upperSigned = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Int64)
  lowerSigned :: Integer
lowerSigned = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Int64)
  upperUnsigned :: Integer
upperUnsigned = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word64)
  bits :: Int
bits = Int
64
  type BitsNat 'B64 = 64

type CanHoldSigned :: Bits -> * -> Constraint
class (BitBounds bits, Num t) => CanHoldSigned bits t where
instance (BitBounds bits, Num t, Signedness t 'Signed, HasWidthFor bits t) => CanHoldSigned bits t

type CanHoldUnsigned :: Bits -> * -> Constraint
class (BitBounds bits, Num t) => CanHoldUnsigned bits t where
instance (BitBounds bits, Num t, Signedness t 'Unsigned, HasWidthFor bits t) => CanHoldUnsigned bits t

type IntegerParsers :: (Bits -> * -> Constraint) -> *
data IntegerParsers canHold = IntegerParsers { forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
decimal :: Parsec Integer
                                             , forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: Parsec Integer
                                             , forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: Parsec Integer
                                             , forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: Parsec Integer
                                             , forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: Parsec Integer
                                             , forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded :: forall (bits :: Bits) t. canHold bits t => Proxy bits -> Parsec Integer -> Int -> Parsec t
                                             }

decimalBounded :: forall (bits :: Bits) canHold t. canHold bits t => IntegerParsers canHold -> Parsec t
decimalBounded :: forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
decimalBounded IntegerParsers{Parsec Integer
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
_bounded :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..} = Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded (forall {k} (t :: k). Proxy t
forall (t :: Bits). Proxy t
Proxy @bits) Parsec Integer
decimal Int
10

hexadecimalBounded :: forall (bits :: Bits) canHold t. canHold bits t => IntegerParsers canHold -> Parsec t
hexadecimalBounded :: forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
hexadecimalBounded IntegerParsers{Parsec Integer
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
_bounded :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..} = Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded (forall {k} (t :: k). Proxy t
forall (t :: Bits). Proxy t
Proxy @bits) Parsec Integer
hexadecimal Int
16

octalBounded :: forall (bits :: Bits) canHold t. canHold bits t => IntegerParsers canHold -> Parsec t
octalBounded :: forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
octalBounded IntegerParsers{Parsec Integer
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
_bounded :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..} = Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded (forall {k} (t :: k). Proxy t
forall (t :: Bits). Proxy t
Proxy @bits) Parsec Integer
octal Int
8

binaryBounded :: forall (bits :: Bits) canHold t. canHold bits t => IntegerParsers canHold -> Parsec t
binaryBounded :: forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
binaryBounded IntegerParsers{Parsec Integer
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
_bounded :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..} = Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded (forall {k} (t :: k). Proxy t
forall (t :: Bits). Proxy t
Proxy @bits) Parsec Integer
binary Int
2

numberBounded :: forall (bits :: Bits) canHold t. canHold bits t => IntegerParsers canHold -> Parsec t
numberBounded :: forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
numberBounded IntegerParsers{Parsec Integer
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
_bounded :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..} = Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
canHold bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded (forall {k} (t :: k). Proxy t
forall (t :: Bits). Proxy t
Proxy @bits) Parsec Integer
number Int
10

decimal8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a
decimal8 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B8 a =>
IntegerParsers canHold -> Parsec a
decimal8 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
decimalBounded @'B8
hexadecimal8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a
hexadecimal8 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B8 a =>
IntegerParsers canHold -> Parsec a
hexadecimal8 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
hexadecimalBounded @'B8
octal8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a
octal8 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B8 a =>
IntegerParsers canHold -> Parsec a
octal8 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
octalBounded @'B8
binary8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a
binary8 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B8 a =>
IntegerParsers canHold -> Parsec a
binary8 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
binaryBounded @'B8
number8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a
number8 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B8 a =>
IntegerParsers canHold -> Parsec a
number8 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
numberBounded @'B8

decimal16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a
decimal16 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B16 a =>
IntegerParsers canHold -> Parsec a
decimal16 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
decimalBounded @'B16
hexadecimal16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a
hexadecimal16 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B16 a =>
IntegerParsers canHold -> Parsec a
hexadecimal16 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
hexadecimalBounded @'B16
octal16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a
octal16 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B16 a =>
IntegerParsers canHold -> Parsec a
octal16 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
octalBounded @'B16
binary16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a
binary16 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B16 a =>
IntegerParsers canHold -> Parsec a
binary16 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
binaryBounded @'B16
number16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a
number16 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B16 a =>
IntegerParsers canHold -> Parsec a
number16 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
numberBounded @'B16

decimal32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a
decimal32 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B32 a =>
IntegerParsers canHold -> Parsec a
decimal32 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
decimalBounded @'B32
hexadecimal32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a
hexadecimal32 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B32 a =>
IntegerParsers canHold -> Parsec a
hexadecimal32 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
hexadecimalBounded @'B32
octal32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a
octal32 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B32 a =>
IntegerParsers canHold -> Parsec a
octal32 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
octalBounded @'B32
binary32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a
binary32 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B32 a =>
IntegerParsers canHold -> Parsec a
binary32 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
binaryBounded @'B32
number32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a
number32 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B32 a =>
IntegerParsers canHold -> Parsec a
number32 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
numberBounded @'B32

decimal64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a
decimal64 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B64 a =>
IntegerParsers canHold -> Parsec a
decimal64 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
decimalBounded @'B64
hexadecimal64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a
hexadecimal64 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B64 a =>
IntegerParsers canHold -> Parsec a
hexadecimal64 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
hexadecimalBounded @'B64
octal64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a
octal64 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B64 a =>
IntegerParsers canHold -> Parsec a
octal64 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
octalBounded @'B64
binary64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a
binary64 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B64 a =>
IntegerParsers canHold -> Parsec a
binary64 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
binaryBounded @'B64
number64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a
number64 :: forall a (canHold :: Bits -> * -> Constraint).
canHold 'B64 a =>
IntegerParsers canHold -> Parsec a
number64 = forall (bits :: Bits) (canHold :: Bits -> * -> Constraint) t.
canHold bits t =>
IntegerParsers canHold -> Parsec t
numberBounded @'B64

outOfBounds :: Integer -> Integer -> Int -> Integer -> [String]
outOfBounds :: Integer -> Integer -> Int -> Integer -> [String]
outOfBounds Integer
small Integer
big Int
radix Integer
_n = [
    String
"literal is not within the range " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String -> String
resign Integer
small (String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String -> String
resign Integer
big String
"")
  ]
  where resign :: Integer -> String -> String
resign Integer
n
          | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = (Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Int -> Char) -> Integer -> String -> String
forall a. Integral a => a -> (Int -> Char) -> a -> String -> String
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n)
          | Bool
otherwise = Integer -> (Int -> Char) -> Integer -> String -> String
forall a. Integral a => a -> (Int -> Char) -> a -> String -> String
showIntAtBase (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix) Int -> Char
intToDigit Integer
n

mkUnsigned :: NumericDesc -> GenericNumeric -> IntegerParsers CanHoldUnsigned
mkUnsigned :: NumericDesc -> GenericNumeric -> IntegerParsers CanHoldUnsigned
mkUnsigned desc :: NumericDesc
desc@NumericDesc{Bool
Set Char
PlusSignPresence
BreakCharDesc
positiveSign :: NumericDesc -> PlusSignPresence
literalBreakChar :: NumericDesc -> BreakCharDesc
integerNumbersCanBeHexadecimal :: NumericDesc -> Bool
integerNumbersCanBeOctal :: NumericDesc -> Bool
integerNumbersCanBeBinary :: NumericDesc -> Bool
hexadecimalLeads :: NumericDesc -> Set Char
octalLeads :: NumericDesc -> Set Char
binaryLeads :: NumericDesc -> Set Char
literalBreakChar :: BreakCharDesc
positiveSign :: PlusSignPresence
integerNumbersCanBeHexadecimal :: Bool
integerNumbersCanBeOctal :: Bool
integerNumbersCanBeBinary :: Bool
hexadecimalLeads :: Set Char
octalLeads :: Set Char
binaryLeads :: Set Char
..} GenericNumeric
gen = IntegerParsers {Parsec Integer
Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
CanHoldUnsigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
CanHoldUnsigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded :: forall (bits :: Bits) t.
CanHoldUnsigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
..}
  where _bounded :: forall (bits :: Bits) t. CanHoldUnsigned bits t
                 => Proxy bits -> Parsec Integer -> Int -> Parsec t
        _bounded :: forall (bits :: Bits) t.
CanHoldUnsigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded Proxy bits
_ Parsec Integer
num Int
radix = ErrorGen Integer
-> (Integer -> Maybe t) -> Parsec Integer -> Parsec t
forall a b. ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSWith
          (ErrorGen Integer
forall a. ErrorGen a
specializedGen { messages = outOfBounds 0 (upperUnsigned @bits) radix })
          (\Integer
n -> if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= forall (b :: Bits). BitBounds b => Integer
upperUnsigned @bits then t -> Maybe t
forall a. a -> Maybe a
Just (Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
n) else Maybe t
forall a. Maybe a
Nothing)
          Parsec Integer
num

        leadingBreakChar :: Parsec ()
leadingBreakChar = case BreakCharDesc
literalBreakChar of
          BreakCharDesc
NoBreakChar -> Parsec ()
unit
          BreakCharSupported Char
breakChar Bool
allowedAfterNonDecimalPrefix ->
            Bool -> Parsec () -> Parsec ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
allowedAfterNonDecimalPrefix (Parsec Char -> Parsec ()
forall a. Parsec a -> Parsec ()
optional (Char -> Parsec Char
char Char
breakChar))

        noZeroHexadecimal :: Parsec Integer
noZeroHexadecimal = do
          Bool -> Parsec () -> Parsec ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Char -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Char
hexadecimalLeads) (Parsec Char -> Parsec ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Set Char -> Parsec Char
oneOf Set Char
hexadecimalLeads))
          Parsec ()
leadingBreakChar
          GenericNumeric -> NumericDesc -> Parsec Integer
plainHexadecimal GenericNumeric
gen NumericDesc
desc

        noZeroOctal :: Parsec Integer
noZeroOctal = do
          Bool -> Parsec () -> Parsec ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Char -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Char
octalLeads) (Parsec Char -> Parsec ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Set Char -> Parsec Char
oneOf Set Char
octalLeads))
          Parsec ()
leadingBreakChar
          GenericNumeric -> NumericDesc -> Parsec Integer
plainOctal GenericNumeric
gen NumericDesc
desc

        noZeroBinary :: Parsec Integer
noZeroBinary = do
          Bool -> Parsec () -> Parsec ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Char -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Char
binaryLeads) (Parsec Char -> Parsec ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Set Char -> Parsec Char
oneOf Set Char
binaryLeads))
          Parsec ()
leadingBreakChar
          GenericNumeric -> NumericDesc -> Parsec Integer
plainBinary GenericNumeric
gen NumericDesc
desc

        decimal :: Parsec Integer
decimal = GenericNumeric -> NumericDesc -> Parsec Integer
plainDecimal GenericNumeric
gen NumericDesc
desc
        hexadecimal :: Parsec Integer
hexadecimal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Char -> Parsec Char
char Char
'0' Parsec Char -> Parsec Integer -> Parsec Integer
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Integer
noZeroHexadecimal)
        octal :: Parsec Integer
octal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Char -> Parsec Char
char Char
'0' Parsec Char -> Parsec Integer -> Parsec Integer
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Integer
noZeroOctal)
        binary :: Parsec Integer
binary = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Char -> Parsec Char
char Char
'0' Parsec Char -> Parsec Integer -> Parsec Integer
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Integer
noZeroBinary)
        number :: Parsec Integer
number
          | Bool -> Bool
not Bool
integerNumbersCanBeBinary
          , Bool -> Bool
not Bool
integerNumbersCanBeHexadecimal
          , Bool -> Bool
not Bool
integerNumbersCanBeOctal = Parsec Integer
decimal
          | Bool
otherwise = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Parsec Integer
zeroLead Parsec Integer -> Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Integer
decimal)
          where zeroLead :: Parsec Integer
zeroLead = Char -> Parsec Char
char Char
'0' Parsec Char -> Parsec Integer -> Parsec Integer
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Integer -> Parsec Integer
addHex (Parsec Integer -> Parsec Integer
addOct (Parsec Integer -> Parsec Integer
addBin (Parsec Integer
decimal Parsec Integer -> Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Parsec Integer
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)))
                addHex :: Parsec Integer -> Parsec Integer
addHex
                  | Bool
integerNumbersCanBeHexadecimal = (Parsec Integer
noZeroHexadecimal Parsec Integer -> Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>)
                  | Bool
otherwise = Parsec Integer -> Parsec Integer
forall a. a -> a
id
                addOct :: Parsec Integer -> Parsec Integer
addOct
                  | Bool
integerNumbersCanBeOctal = (Parsec Integer
noZeroOctal Parsec Integer -> Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>)
                  | Bool
otherwise = Parsec Integer -> Parsec Integer
forall a. a -> a
id
                addBin :: Parsec Integer -> Parsec Integer
addBin
                  | Bool
integerNumbersCanBeBinary = (Parsec Integer
noZeroBinary Parsec Integer -> Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>)
                  | Bool
otherwise = Parsec Integer -> Parsec Integer
forall a. a -> a
id

mkSigned :: NumericDesc -> IntegerParsers c -> IntegerParsers CanHoldSigned
mkSigned :: forall (c :: Bits -> * -> Constraint).
NumericDesc -> IntegerParsers c -> IntegerParsers CanHoldSigned
mkSigned NumericDesc{Bool
Set Char
PlusSignPresence
BreakCharDesc
positiveSign :: NumericDesc -> PlusSignPresence
literalBreakChar :: NumericDesc -> BreakCharDesc
integerNumbersCanBeHexadecimal :: NumericDesc -> Bool
integerNumbersCanBeOctal :: NumericDesc -> Bool
integerNumbersCanBeBinary :: NumericDesc -> Bool
hexadecimalLeads :: NumericDesc -> Set Char
octalLeads :: NumericDesc -> Set Char
binaryLeads :: NumericDesc -> Set Char
literalBreakChar :: BreakCharDesc
positiveSign :: PlusSignPresence
integerNumbersCanBeHexadecimal :: Bool
integerNumbersCanBeOctal :: Bool
integerNumbersCanBeBinary :: Bool
hexadecimalLeads :: Set Char
octalLeads :: Set Char
binaryLeads :: Set Char
..} IntegerParsers c
unsigned = IntegerParsers {
    decimal :: Parsec Integer
decimal = Parsec Integer
_decimal,
    hexadecimal :: Parsec Integer
hexadecimal = Parsec Integer
_hexadecimal,
    octal :: Parsec Integer
octal = Parsec Integer
_octal,
    binary :: Parsec Integer
binary = Parsec Integer
_binary,
    number :: Parsec Integer
number = Parsec Integer
_number,
    Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
CanHoldSigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded :: forall (bits :: Bits) t.
CanHoldSigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded :: forall (bits :: Bits) t.
CanHoldSigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..
  }
  where _bounded :: forall (bits :: Bits) t. CanHoldSigned bits t
                 => Proxy bits -> Parsec Integer -> Int -> Parsec t
        _bounded :: forall (bits :: Bits) t.
CanHoldSigned bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded Proxy bits
_ Parsec Integer
num Int
radix = ErrorGen Integer
-> (Integer -> Maybe t) -> Parsec Integer -> Parsec t
forall a b. ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b
mapMaybeSWith
          (ErrorGen Integer
forall a. ErrorGen a
specializedGen { messages = outOfBounds (lowerSigned @bits) (upperSigned @bits) radix })
          (\Integer
n -> if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= forall (b :: Bits). BitBounds b => Integer
lowerSigned @bits Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= forall (b :: Bits). BitBounds b => Integer
upperSigned @bits
                 then t -> Maybe t
forall a. a -> Maybe a
Just (Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
n)
                 else Maybe t
forall a. Maybe a
Nothing)
          Parsec Integer
num

        sign :: Parsec (Integer -> Integer)
        sign :: Parsec (Integer -> Integer)
sign = case PlusSignPresence
positiveSign of
          PlusSignPresence
PlusRequired -> Char -> Parsec Char
char Char
'+' Parsec Char -> (Integer -> Integer) -> Parsec (Integer -> Integer)
forall a b. Parsec a -> b -> Parsec b
$> Integer -> Integer
forall a. a -> a
id Parsec (Integer -> Integer)
-> Parsec (Integer -> Integer) -> Parsec (Integer -> Integer)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parsec Char
char Char
'-' Parsec Char -> (Integer -> Integer) -> Parsec (Integer -> Integer)
forall a b. Parsec a -> b -> Parsec b
$> Integer -> Integer
forall a. Num a => a -> a
negate
          PlusSignPresence
PlusOptional -> Char -> Parsec Char
char Char
'-' Parsec Char -> (Integer -> Integer) -> Parsec (Integer -> Integer)
forall a b. Parsec a -> b -> Parsec b
$> Integer -> Integer
forall a. Num a => a -> a
negate Parsec (Integer -> Integer)
-> Parsec (Integer -> Integer) -> Parsec (Integer -> Integer)
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Integer) -> Parsec Char -> Parsec (Integer -> Integer)
forall b a. b -> Parsec a -> Parsec b
optionalAs Integer -> Integer
forall a. a -> a
id (Char -> Parsec Char
char Char
'+')
          PlusSignPresence
PlusIllegal  -> (Integer -> Integer) -> Parsec (Integer -> Integer)
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer -> Integer
forall a. a -> a
id
        _decimal :: Parsec Integer
_decimal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Parsec (Integer -> Integer)
sign Parsec (Integer -> Integer) -> Parsec Integer -> Parsec Integer
forall a b. Parsec (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntegerParsers c -> Parsec Integer
forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
decimal IntegerParsers c
unsigned)
        _hexadecimal :: Parsec Integer
_hexadecimal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Parsec (Integer -> Integer)
sign Parsec (Integer -> Integer) -> Parsec Integer -> Parsec Integer
forall a b. Parsec (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntegerParsers c -> Parsec Integer
forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal IntegerParsers c
unsigned)
        _octal :: Parsec Integer
_octal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Parsec (Integer -> Integer)
sign Parsec (Integer -> Integer) -> Parsec Integer -> Parsec Integer
forall a b. Parsec (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntegerParsers c -> Parsec Integer
forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal IntegerParsers c
unsigned)
        _binary :: Parsec Integer
_binary = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Parsec (Integer -> Integer)
sign Parsec (Integer -> Integer) -> Parsec Integer -> Parsec Integer
forall a b. Parsec (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntegerParsers c -> Parsec Integer
forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary IntegerParsers c
unsigned)
        _number :: Parsec Integer
_number = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
atomic (Parsec (Integer -> Integer)
sign Parsec (Integer -> Integer) -> Parsec Integer -> Parsec Integer
forall a b. Parsec (a -> b) -> Parsec a -> Parsec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntegerParsers c -> Parsec Integer
forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number IntegerParsers c
unsigned)

{-type FloatingParsers :: *
data FloatingParsers = FloatingParsers {}

mkUnsignedFloating :: NumericDesc -> IntegerParsers CanHoldUnsigned -> GenericNumeric -> FloatingParsers
mkUnsignedFloating NumericDesc{..} nat gen = FloatingParsers {}

mkSignedFloating :: NumericDesc -> FloatingParsers -> FloatingParsers
mkSignedFloating NumericDesc{..} unsigned = FloatingParsers {}

type CombinedParsers :: *
data CombinedParsers = CombinedParsers {}

mkUnsignedCombined :: NumericDesc -> IntegerParsers CanHoldUnsigned -> FloatingParsers -> CombinedParsers
mkUnsignedCombined NumericDesc{..} natural floating = CombinedParsers {}

mkSignedCombined :: NumericDesc -> CombinedParsers -> CombinedParsers
mkSignedCombined NumericDesc{..} unsigned = CombinedParsers {}-}

lexemeInteger :: (forall a. Parsec a -> Parsec a) -> IntegerParsers c -> IntegerParsers c
lexemeInteger :: forall (c :: Bits -> * -> Constraint).
(forall a. Parsec a -> Parsec a)
-> IntegerParsers c -> IntegerParsers c
lexemeInteger forall a. Parsec a -> Parsec a
lexe IntegerParsers{Parsec Integer
forall (bits :: Bits) t.
c bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
hexadecimal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
octal :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
binary :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
number :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold -> Parsec Integer
_bounded :: forall (canHold :: Bits -> * -> Constraint).
IntegerParsers canHold
-> forall (bits :: Bits) t.
   canHold bits t =>
   Proxy bits -> Parsec Integer -> Int -> Parsec t
decimal :: Parsec Integer
hexadecimal :: Parsec Integer
octal :: Parsec Integer
binary :: Parsec Integer
number :: Parsec Integer
_bounded :: forall (bits :: Bits) t.
c bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
..} = IntegerParsers {
    decimal :: Parsec Integer
decimal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
lexe Parsec Integer
decimal,
    hexadecimal :: Parsec Integer
hexadecimal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
lexe Parsec Integer
hexadecimal,
    octal :: Parsec Integer
octal = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
lexe Parsec Integer
octal,
    binary :: Parsec Integer
binary = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
lexe Parsec Integer
binary,
    number :: Parsec Integer
number = Parsec Integer -> Parsec Integer
forall a. Parsec a -> Parsec a
lexe Parsec Integer
number,
    _bounded :: forall (bits :: Bits) t.
c bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded = \Proxy bits
n Parsec Integer
b Int
radix -> Parsec t -> Parsec t
forall a. Parsec a -> Parsec a
lexe (Proxy bits -> Parsec Integer -> Int -> Parsec t
forall (bits :: Bits) t.
c bits t =>
Proxy bits -> Parsec Integer -> Int -> Parsec t
_bounded Proxy bits
n Parsec Integer
b Int
radix)
  }

{-lexemeFloating :: (forall a. Parsec a -> Parsec a) -> FloatingParsers -> FloatingParsers
lexemeFloating = const id

lexemeCombined :: (forall a. Parsec a -> Parsec a) -> CombinedParsers -> CombinedParsers
lexemeCombined = const id
-}