{-| Naturals represented via ASCII digits.

A concept which sees occasional use in places where neither speed nor size
efficiency matter. The tar file format uses it, apparently to sidestep making a
decision on byte ordering. Pretty silly.

As with other binrep string-likes, you probably want to wrap this with
'Binrep.Type.Sized.Sized' or 'Binrep.Type.Prefix.Size.SizePrefixed'.

We use a refinement to permit using any numeric type, while ensuring that
negative values are not permitted.
-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-} -- for refined error
{-# LANGUAGE UndecidableInstances #-} -- for deriving predicate instance

module Binrep.Type.AsciiNat where

import Binrep

import GHC.Exts ( Word(W#), Word#, Int(I#), word2Int#, eqWord#, plusWord# )
import Util.TypeNats ( natValWord )
import Data.Semigroup ( sconcat )

import GHC.Num.Primitives ( wordLogBase# )
import GHC.Num.Natural ( naturalSizeInBase# )

import Data.Word
import Data.Int
import Data.List.NonEmpty ( NonEmpty( (:|) ) )

import GHC.TypeNats ( Natural, KnownNat )

import Data.ByteString qualified as B
import Binrep.Type.Thin ( Thin(Thin) )

import Rerefined.Predicate
import Rerefined.Predicate.Via
import Rerefined.Predicate.Relational.Value
import Rerefined.Predicate.Relational
import Rerefined.Refine
import TypeLevelShow.Natural
import TypeLevelShow.Utils

import Data.Text.Builder.Linear qualified as TBL

{- TODO 2024-10-15 raehik

Should this be a newtype over @a@ where we don't check for >0 ?
After doing some thinking about strongweak vs. generic coerce, I kind of want to
handle cases where we don't really do a check/make a value-level change.
This is the closest I have.

Maybe I want a @Tagged@-like newtype in strongweak that states "strengthen
through the given type as if it's a newtype (that can be coerced)". Maybe that
gets me what I want. @ByteOrdered@ would then use it too.
-}

-- | A natural represented in binary as an ASCII string, where each character is
--   a digit in the given base.
--
-- Only certain bases are supported: 2, 8, 10 and 16.
--
-- Hex parsing permits mixed case digits when parsing (@1-9a-fA-F@), and
-- serializes with lower-case ASCII hex digits.
data AsciiNat (base :: Natural)
--type AsciiNat base = Refined (AsciiNat base)

instance Predicate (AsciiNat base) where
    type PredicateName d (AsciiNat base) = ShowParen (d > 9)
        ("AsciiNat " ++ ShowNatDec base)

instance (KnownPredicateName (AsciiNat base), Num a, Ord a)
  => Refine (AsciiNat base) a where
    validate :: Proxy# (AsciiNat base) -> a -> Maybe RefineFailure
validate = forall {k1} {k2} (pVia :: k1) (p :: k2) a.
(Refine pVia a, Predicate p, KnownPredicateName p) =>
Proxy# p -> a -> Maybe RefineFailure
forall pVia p a.
(Refine pVia a, Predicate p, KnownPredicateName p) =>
Proxy# p -> a -> Maybe RefineFailure
validateVia @(CompareValue RelOpGTE Pos 0)

-- | Compare two 'AsciiNat's, ignoring base information.
asciiNatCompare
    :: Ord a => Refined (AsciiNat bl) a -> Refined (AsciiNat br) a -> Ordering
asciiNatCompare :: forall a (bl :: Natural) (br :: Natural).
Ord a =>
Refined (AsciiNat bl) a -> Refined (AsciiNat br) a -> Ordering
asciiNatCompare Refined (AsciiNat bl) a
l Refined (AsciiNat br) a
r = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Refined (AsciiNat bl) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine Refined (AsciiNat bl) a
l) (Refined (AsciiNat br) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine Refined (AsciiNat br) a
r)

-- | The bytelength of an 'AsciiNat' is the number of digits in the number in
--   the given base. We can calculate this generally with great efficiency
--   using GHC (ghc-bignum) primitives!
instance (HasBaseOps a, KnownNat base) => BLen (Refined (AsciiNat base) a) where
    blen :: Refined (AsciiNat base) a -> Int
blen Refined (AsciiNat base) a
n = Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> a -> Word#
forall a. HasBaseOps a => Word# -> a -> Word#
sizeInBase# Word#
base# (Refined (AsciiNat base) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine Refined (AsciiNat base) a
n)))
      where
        !(W# Word#
base#) = forall (n :: Natural). KnownNat n => Word
natValWord @base

class HasBaseOps a where
    -- | See ghc-bignum internals at @GHC.Num.*@.
    sizeInBase# :: Word# -> a -> Word#

instance HasBaseOps Word    where sizeInBase# :: Word# -> Word -> Word#
sizeInBase# = Word# -> Word -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize
instance HasBaseOps Natural where
    sizeInBase# :: Word# -> Natural -> Word#
sizeInBase# Word#
base = \case
      Natural
0 -> Word#
1##
      Natural
a -> Word# -> Natural -> Word#
naturalSizeInBase# Word#
base Natural
a

instance HasBaseOps Word8  where sizeInBase# :: Word# -> Word8 -> Word#
sizeInBase# = Word# -> Word8 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize
instance HasBaseOps Word16 where sizeInBase# :: Word# -> Word16 -> Word#
sizeInBase# = Word# -> Word16 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize
instance HasBaseOps Word32 where sizeInBase# :: Word# -> Word32 -> Word#
sizeInBase# = Word# -> Word32 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize

-- | TODO unsafe for 32-bit platform
instance HasBaseOps Word64 where sizeInBase# :: Word# -> Word64 -> Word#
sizeInBase# = Word# -> Word64 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize

instance HasBaseOps Int8   where sizeInBase# :: Word# -> Int8 -> Word#
sizeInBase# = Word# -> Int8 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize
instance HasBaseOps Int16  where sizeInBase# :: Word# -> Int16 -> Word#
sizeInBase# = Word# -> Int16 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize
instance HasBaseOps Int32  where sizeInBase# :: Word# -> Int32 -> Word#
sizeInBase# = Word# -> Int32 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize

-- | TODO unsafe for 32-bit platform
instance HasBaseOps Int64  where sizeInBase# :: Word# -> Int64 -> Word#
sizeInBase# = Word# -> Int64 -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize

-- | 'Int' can use 'Word' size (but TODO what happens for negatives?)
instance HasBaseOps Int  where sizeInBase# :: Word# -> Int -> Word#
sizeInBase# = Word# -> Int -> Word#
forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize

-- | Safe for types smaller than a 'Word'.
--
-- Uses ghc-bignum internals. Slightly unwrapped for better performance.
--
-- One could perhaps write faster algorithms for smaller primitive types too...
-- but performance increase would be minimal if even present.
sizeInBaseWordSize :: Integral a => Word# -> a -> Word#
sizeInBaseWordSize :: forall a. Integral a => Word# -> a -> Word#
sizeInBaseWordSize Word#
base a
a =
    case Word#
w# Word# -> Word# -> Int#
`eqWord#` Word#
0## of
      Int#
1# -> Word#
1##
      Int#
_  -> Word#
1## Word# -> Word# -> Word#
`plusWord#` Word# -> Word# -> Word#
wordLogBase# Word#
base Word#
w#
  where
    !(W# Word#
w#) = a -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a

-- | Serialize any term of an 'Integral' type to binary (base 2) ASCII.
instance Integral a => Put (Refined (AsciiNat  2) a) where
    put :: Refined (AsciiNat 2) a -> Putter
put = NonEmpty Putter -> Putter
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Putter -> Putter)
-> (Refined (AsciiNat 2) a -> NonEmpty Putter)
-> Refined (AsciiNat 2) a
-> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Putter) -> NonEmpty Word8 -> NonEmpty Putter
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Putter
forall a. Put a => a -> Putter
put (Word8 -> Putter) -> (Word8 -> Word8) -> Word8 -> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(+) Word8
0x30) (NonEmpty Word8 -> NonEmpty Putter)
-> (Refined (AsciiNat 2) a -> NonEmpty Word8)
-> Refined (AsciiNat 2) a
-> NonEmpty Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
unsafeDigits @Word8  a
2 (a -> NonEmpty Word8)
-> (Refined (AsciiNat 2) a -> a)
-> Refined (AsciiNat 2) a
-> NonEmpty Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined (AsciiNat 2) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine

-- | Serialize any term of an 'Integral' type to octal (base 8) ASCII.
instance Integral a => Put (Refined (AsciiNat  8) a) where
    put :: Refined (AsciiNat 8) a -> Putter
put = NonEmpty Putter -> Putter
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Putter -> Putter)
-> (Refined (AsciiNat 8) a -> NonEmpty Putter)
-> Refined (AsciiNat 8) a
-> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Putter) -> NonEmpty Word8 -> NonEmpty Putter
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Putter
forall a. Put a => a -> Putter
put (Word8 -> Putter) -> (Word8 -> Word8) -> Word8 -> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(+) Word8
0x30) (NonEmpty Word8 -> NonEmpty Putter)
-> (Refined (AsciiNat 8) a -> NonEmpty Word8)
-> Refined (AsciiNat 8) a
-> NonEmpty Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
unsafeDigits @Word8  a
8 (a -> NonEmpty Word8)
-> (Refined (AsciiNat 8) a -> a)
-> Refined (AsciiNat 8) a
-> NonEmpty Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined (AsciiNat 8) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine

-- | Serialize any term of an 'Integral' type to decimal (base 10) ASCII.
instance Integral a => Put (Refined (AsciiNat 10) a) where
    put :: Refined (AsciiNat 10) a -> Putter
put = NonEmpty Putter -> Putter
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Putter -> Putter)
-> (Refined (AsciiNat 10) a -> NonEmpty Putter)
-> Refined (AsciiNat 10) a
-> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Putter) -> NonEmpty Word8 -> NonEmpty Putter
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Putter
forall a. Put a => a -> Putter
put (Word8 -> Putter) -> (Word8 -> Word8) -> Word8 -> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(+) Word8
0x30) (NonEmpty Word8 -> NonEmpty Putter)
-> (Refined (AsciiNat 10) a -> NonEmpty Word8)
-> Refined (AsciiNat 10) a
-> NonEmpty Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
unsafeDigits @Word8 a
10 (a -> NonEmpty Word8)
-> (Refined (AsciiNat 10) a -> a)
-> Refined (AsciiNat 10) a
-> NonEmpty Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined (AsciiNat 10) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine

-- | Serialize any term of an 'Integral' type to hex (base 16) ASCII.
--
-- Uses lower-case ASCII.
instance Integral a => Put (Refined (AsciiNat 16) a) where
    put :: Refined (AsciiNat 16) a -> Putter
put =
          NonEmpty Putter -> Putter
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty Putter -> Putter)
-> (Refined (AsciiNat 16) a -> NonEmpty Putter)
-> Refined (AsciiNat 16) a
-> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Putter) -> NonEmpty Word8 -> NonEmpty Putter
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Putter
forall a. Put a => a -> Putter
put (Word8 -> Putter) -> (Word8 -> Word8) -> Word8 -> Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
forall a. (Num a, Ord a) => a -> a
unsafeHexDigitToAsciiLower)
        (NonEmpty Word8 -> NonEmpty Putter)
-> (Refined (AsciiNat 16) a -> NonEmpty Word8)
-> Refined (AsciiNat 16) a
-> NonEmpty Putter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
unsafeDigits @Word8 a
16 (a -> NonEmpty Word8)
-> (Refined (AsciiNat 16) a -> a)
-> Refined (AsciiNat 16) a
-> NonEmpty Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined (AsciiNat 16) a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine

-- | Parse a  binary  (base 2) ASCII natural to any 'Num' type.
instance (Num a, Ord a) => Get (Refined (AsciiNat  2)  a) where
    get :: Getter (Refined (AsciiNat 2) a)
get = a -> Refined (AsciiNat 2) a
forall {k} a (p :: k). a -> Refined p a
unsafeRefine (a -> Refined (AsciiNat 2) a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (Refined (AsciiNat 2) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Builder
-> (a -> Maybe a)
-> ParserT PureMode (ParseError Pos Builder) a
forall a. Num a => a -> Builder -> (a -> Maybe a) -> Getter a
getAsciiNatByByte a
2  Builder
"binary"  a -> Maybe a
forall a. (Num a, Ord a) => a -> Maybe a
parseBinaryAsciiDigit

-- | Parse an octal   (base 8) ASCII natural to any 'Num' type.
instance (Num a, Ord a) => Get (Refined (AsciiNat  8)  a) where
    get :: Getter (Refined (AsciiNat 8) a)
get = a -> Refined (AsciiNat 8) a
forall {k} a (p :: k). a -> Refined p a
unsafeRefine (a -> Refined (AsciiNat 8) a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (Refined (AsciiNat 8) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Builder
-> (a -> Maybe a)
-> ParserT PureMode (ParseError Pos Builder) a
forall a. Num a => a -> Builder -> (a -> Maybe a) -> Getter a
getAsciiNatByByte a
8  Builder
"octal"   a -> Maybe a
forall a. (Num a, Ord a) => a -> Maybe a
parseOctalAsciiDigit

-- | Parse a  decimal (base 10) ASCII natural to any 'Num' type.
instance (Num a, Ord a) => Get (Refined (AsciiNat 10) a) where
    get :: Getter (Refined (AsciiNat 10) a)
get = a -> Refined (AsciiNat 10) a
forall {k} a (p :: k). a -> Refined p a
unsafeRefine (a -> Refined (AsciiNat 10) a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (Refined (AsciiNat 10) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Builder
-> (a -> Maybe a)
-> ParserT PureMode (ParseError Pos Builder) a
forall a. Num a => a -> Builder -> (a -> Maybe a) -> Getter a
getAsciiNatByByte a
10 Builder
"decimal" a -> Maybe a
forall a. (Num a, Ord a) => a -> Maybe a
parseDecimalAsciiDigit

-- | Parse a  hex     (base 16) ASCII natural to any 'Num' type.
--
-- Parses lower and upper case (mixed permitted).
instance (Num a, Ord a) => Get (Refined (AsciiNat 16) a) where
    get :: Getter (Refined (AsciiNat 16) a)
get = a -> Refined (AsciiNat 16) a
forall {k} a (p :: k). a -> Refined p a
unsafeRefine (a -> Refined (AsciiNat 16) a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (Refined (AsciiNat 16) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a
-> Builder
-> (a -> Maybe a)
-> ParserT PureMode (ParseError Pos Builder) a
forall a. Num a => a -> Builder -> (a -> Maybe a) -> Getter a
getAsciiNatByByte a
16 Builder
"hex"     a -> Maybe a
forall a. (Num a, Ord a) => a -> Maybe a
parseHexAsciiDigit

-- | Parse an ASCII natural in the given base with the given digit parser.
--
-- Parses byte-by-byte. As such, it only supports bases up to 256.
getAsciiNatByByte :: Num a => a -> TBL.Builder -> (a -> Maybe a) -> Getter a
getAsciiNatByByte :: forall a. Num a => a -> Builder -> (a -> Maybe a) -> Getter a
getAsciiNatByByte a
base Builder
baseStr a -> Maybe a
f = do
    Thin ByteString
bs <- Getter (Thin ByteString)
forall a. Get a => Getter a
get -- no need to copy since we consume during parsing!
    if   ByteString -> Bool
B.null ByteString
bs
    then [Builder] -> Getter a
forall text (st :: ZeroBitType) a.
[text] -> ParserT st (ParseError Pos text) a
err1 [Builder
"ASCII natural cannot be empty"]
    else case (a -> Maybe a) -> a -> ByteString -> Either Word8 a
forall a.
Num a =>
(a -> Maybe a) -> a -> ByteString -> Either Word8 a
asciiBytesToNat a -> Maybe a
f a
base ByteString
bs of
          Left  Word8
b -> [Builder] -> Getter a
forall text (st :: ZeroBitType) a.
[text] -> ParserT st (ParseError Pos text) a
err1 [
            Builder
"non-"Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
baseStrBuilder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
" ASCII digit in "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
baseStrBuilder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
" ASCII natural: "Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Word8 -> Builder
forall a. (Integral a, FiniteBits a) => a -> Builder
TBL.fromDec Word8
b]
          Right a
n -> a -> Getter a
forall a. a -> ParserT PureMode (ParseError Pos Builder) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
n

{- | Get the digits in the given number as rendered in the given base.

Digits will be between 0-base. The return type must be sized to support this.

Base must be > 2. This is not checked. (Internal function eh.)

Note the 'NonEmpty' return type. Returns @[0]@ for 0 input. (This does not match
ghc-bignum's @sizeInBase@ primitives!)
-}
unsafeDigits :: forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
unsafeDigits :: forall b a. (Integral a, Integral b) => a -> a -> NonEmpty b
unsafeDigits a
base = [b] -> a -> NonEmpty b
go []
  where
    go :: [b] -> a -> NonEmpty b
go [b]
s a
x = NonEmpty b -> a -> NonEmpty b
loop (b
head' b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
s) a
tail'
      where
        head' :: b
head' = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
base)
        tail' :: a
tail' = a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
base
    loop :: NonEmpty b -> a -> NonEmpty b
loop s :: NonEmpty b
s@(b
r :| [b]
rs) = \case
        a
0 -> NonEmpty b
s
        a
x -> [b] -> a -> NonEmpty b
go (b
r b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
rs) a
x

asciiBytesToNat
    :: Num a => (a -> Maybe a) -> a -> B.ByteString -> Either Word8 a
asciiBytesToNat :: forall a.
Num a =>
(a -> Maybe a) -> a -> ByteString -> Either Word8 a
asciiBytesToNat a -> Maybe a
f a
base ByteString
bs =
    -- we use Int for exponent because it seems most sensible & gets SPECIALISEd
    case (Word8 -> Either Word8 (a, Int) -> Either Word8 (a, Int))
-> Either Word8 (a, Int) -> ByteString -> Either Word8 (a, Int)
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr Word8 -> Either Word8 (a, Int) -> Either Word8 (a, Int)
go ((a, Int) -> Either Word8 (a, Int)
forall a b. b -> Either a b
Right (a
0, (Int
0 :: Int))) ByteString
bs of
      Left Word8
w -> Word8 -> Either Word8 a
forall a b. a -> Either a b
Left Word8
w
      Right (a
n, Int
_) -> a -> Either Word8 a
forall a b. b -> Either a b
Right a
n
  where
    go :: Word8 -> Either Word8 (a, Int) -> Either Word8 (a, Int)
go Word8
_ (Left Word8
w) = Word8 -> Either Word8 (a, Int)
forall a b. a -> Either a b
Left Word8
w
    go Word8
w (Right (a
n, Int
expo)) =
        case a -> Maybe a
f (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) of
          Maybe a
Nothing -> Word8 -> Either Word8 (a, Int)
forall a b. a -> Either a b
Left Word8
w
          Just a
d  -> (a, Int) -> Either Word8 (a, Int)
forall a b. b -> Either a b
Right (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
d a -> a -> a
forall a. Num a => a -> a -> a
* a
basea -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
expo, Int
expoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

parseBinaryAsciiDigit :: (Num a, Ord a) => a -> Maybe a
parseBinaryAsciiDigit :: forall a. (Num a, Ord a) => a -> Maybe a
parseBinaryAsciiDigit = \case
  a
0x30 -> a -> Maybe a
forall a. a -> Maybe a
Just a
0 -- 0
  a
0x31 -> a -> Maybe a
forall a. a -> Maybe a
Just a
1 -- 1
  a
_    -> Maybe a
forall a. Maybe a
Nothing

parseOctalAsciiDigit :: (Num a, Ord a) => a -> Maybe a
parseOctalAsciiDigit :: forall a. (Num a, Ord a) => a -> Maybe a
parseOctalAsciiDigit a
a
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x30 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x37 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
0x30 -- 0-7
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

parseDecimalAsciiDigit :: (Num a, Ord a) => a -> Maybe a
parseDecimalAsciiDigit :: forall a. (Num a, Ord a) => a -> Maybe a
parseDecimalAsciiDigit a
a
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x30 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x39 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
0x30 -- 0-9
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

parseHexAsciiDigit :: (Num a, Ord a) => a -> Maybe a
parseHexAsciiDigit :: forall a. (Num a, Ord a) => a -> Maybe a
parseHexAsciiDigit a
a
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x30 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x39 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
0x30 -- 0-9
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x41 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x46 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
0x37 -- A-F (upper case)
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x61 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x66 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
0x57 -- a-f (lower case)
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

-- | May only be called with 0<=n<=15.
unsafeHexDigitToAsciiLower :: (Num a, Ord a) => a -> a
unsafeHexDigitToAsciiLower :: forall a. (Num a, Ord a) => a -> a
unsafeHexDigitToAsciiLower a
a
  | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9    = a
0x30 a -> a -> a
forall a. Num a => a -> a -> a
+ a
a
  | Bool
otherwise = a
0x57 a -> a -> a
forall a. Num a => a -> a -> a
+ a
a

{-

-- | Print a binary (base 2) ASCII natural with an @0b@ prefix.
prettyAsciiNat2 :: Integral a => Int -> a -> ShowS
prettyAsciiNat2 _ n = showString "0b" . showBin n

-- | Show binary (base 2) ASCII naturals with an @0b@ prefix.
instance Integral a => Show (AsciiNat 2 a) where
    showsPrec _ n = showString "0b" . showBin (unAsciiNat n)

-- | Show octal (base 8) ASCII naturals with an @0o@ prefix.
instance Integral a => Show (AsciiNat 8  a) where
    showsPrec _ n = showString "0o" . showOct (unAsciiNat n)

-- | Show decimal (base 10) ASCII naturals with no prefix.
instance Integral a => Show (AsciiNat 10 a) where
    showsPrec _ = showInt . unAsciiNat

-- | Show hex (base 16) ASCII naturals with an @0x@ prefix.
instance Integral a => Show (AsciiNat 16 a) where
    showsPrec _ n = showString "0x" . showHex (unAsciiNat n)

-}