{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE BangPatterns #-}
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Data.ByteString.Lex.Integral
-- Copyright   :  Copyright (c) 2010--2021 wren gayle romano
-- License     :  BSD2
-- Maintainer  :  wren@cpan.org
-- Stability   :  provisional
-- Portability :  BangPatterns
--
-- Functions for parsing and producing 'Integral' values from\/to
-- 'ByteString's based on the \"Char8\" encoding. That is, we assume
-- an ASCII-compatible encoding of alphanumeric characters.
--
-- /Since: 0.3.0/
----------------------------------------------------------------
module Data.ByteString.Lex.Integral
    (
    -- * General combinators
      readSigned
    -- , packSigned
    -- * Decimal conversions
    , readDecimal
    , readDecimal_
    , packDecimal
    -- TODO: asDecimal -- this will be really hard to make efficient...
    -- * Hexadecimal conversions
    , readHexadecimal
    , packHexadecimal
    , asHexadecimal
    -- * Octal conversions
    , readOctal
    , packOctal
    -- asOctal -- this will be really hard to make efficient...
    ) where

import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as BS8 (pack)
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Unsafe   as BSU
import           Data.Int
import           Data.Word
import           Data.Bits
import           Foreign.Ptr              (Ptr, plusPtr)
import qualified Foreign.ForeignPtr       as FFI (withForeignPtr)
import           Foreign.Storable         (peek, poke)
import           Data.ByteString.Lex.Internal

----------------------------------------------------------------
----- General

-- TODO: On the one hand, making this a combinator is "the right
-- thing to do" for generality. However, for performance critical
-- code, we could optimize away some extraneous guards if we just
-- provide both signed and unsigned versions of the
-- {read,pack}{Decimal,Octal,Hex} functions...

-- TODO: move to somewhere more general, shared by both Integral and Fractional
-- | Adjust a reading function to recognize an optional leading
-- sign. As with the other functions, we assume an ASCII-compatible
-- encoding of the sign characters.
readSigned
    :: (Num a)
    => (ByteString -> Maybe (a, ByteString))
    ->  ByteString -> Maybe (a, ByteString)
readSigned :: forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
readSigned ByteString -> Maybe (a, ByteString)
f ByteString
xs
    | ByteString -> Bool
BS.null ByteString
xs = forall a. Maybe a
Nothing
    | Bool
otherwise  =
        case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
        Word8
0x2D -> ByteString -> Maybe (a, ByteString)
f (ByteString -> ByteString
BSU.unsafeTail ByteString
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
n, ByteString
ys) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a
negate a
n, ByteString
ys)
        Word8
0x2B -> ByteString -> Maybe (a, ByteString)
f (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
        Word8
_    -> ByteString -> Maybe (a, ByteString)
f ByteString
xs


----------------------------------------------------------------
----- Decimal

{-
-- We unroll this definition in order to reduce the number of conversions from native Int to the Integral type.
readDecimalSimple :: (Integral a) => ByteString -> Maybe (a, ByteString)
readDecimalSimple = start
    where
    -- This implementation is near verbatim from
    -- bytestring-0.9.1.7:Data.ByteString.Char8.readInt. We do
    -- remove the superstrictness by lifting the 'Just' so it can
    -- be returned after seeing the first byte. Do beware of the
    -- scope of 'fromIntegral', we want to avoid unnecessary
    -- 'Integral' operations and do as much as possible in 'Word8'.
    start xs
        | BS.null xs = Nothing
        | otherwise  =
            case BSU.unsafeHead xs of
            w | 0x39 >= w && w >= 0x30 ->
                    Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs)
              | otherwise -> Nothing

    loop !n !xs
        | BS.null xs = (n, BS.empty) -- not @xs@, to help GC
        | otherwise  =
            case BSU.unsafeHead xs of
            w | 0x39 >= w && w >= 0x30 ->
                    loop (n * 10 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs)
              | otherwise -> (n,xs)
-}

-- | Read an unsigned\/non-negative integral value in ASCII decimal
-- format. Returns @Nothing@ if there is no integer at the beginning
-- of the string, otherwise returns @Just@ the integer read and the
-- remainder of the string.
--
-- If you are extremely concerned with performance, then it is more
-- performant to use this function at @Int@ or @Word@ and then to
-- call 'fromIntegral' to perform the conversion at the end. However,
-- doing this will make your code succeptible to overflow bugs if
-- the target type is larger than @Int@.
readDecimal :: (Integral a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readDecimal ::
    ByteString -> Maybe (Int,     ByteString),
    ByteString -> Maybe (Int8,    ByteString),
    ByteString -> Maybe (Int16,   ByteString),
    ByteString -> Maybe (Int32,   ByteString),
    ByteString -> Maybe (Int64,   ByteString),
    ByteString -> Maybe (Integer, ByteString),
    ByteString -> Maybe (Word,    ByteString),
    ByteString -> Maybe (Word8,   ByteString),
    ByteString -> Maybe (Word16,  ByteString),
    ByteString -> Maybe (Word32,  ByteString),
    ByteString -> Maybe (Word64,  ByteString) #-}
readDecimal :: forall a. Integral a => ByteString -> Maybe (a, ByteString)
readDecimal = forall a. Integral a => ByteString -> Maybe (a, ByteString)
start
    where
    -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop?
    start :: (Integral a) => ByteString -> Maybe (a, ByteString)
    start :: forall a. Integral a => ByteString -> Maybe (a, ByteString)
start ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = forall a. Maybe a
Nothing
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> ByteString -> (a, ByteString)
loop0 (forall a. Integral a => Word8 -> a
toDigit Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> forall a. Maybe a
Nothing

    loop0 :: (Integral a) => a -> ByteString -> (a, ByteString)
    loop0 :: forall a. Integral a => a -> ByteString -> (a, ByteString)
loop0 !a
m !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
m, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop1 a
m (forall a. Integral a => Word8 -> a
toDigit Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
m, ByteString
xs)

    loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8
        :: (Integral a) => a -> Int -> ByteString -> (a, ByteString)
    loop1 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop1 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop2 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop2 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop2 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
100 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop3 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
100 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop3 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop3 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
1000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop4 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
1000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop4 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop4 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
10000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop5 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
10000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop5 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop5 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
100000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop6 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
100000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop6 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop6 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
1000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop7 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
1000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop7 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop7 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
10000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop8 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
10000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)
    loop8 :: forall a. Integral a => a -> Int -> ByteString -> (a, ByteString)
loop8 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (a
mforall a. Num a => a -> a -> a
*a
100000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
BS.empty)
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> ByteString -> (a, ByteString)
loop0
                    (a
mforall a. Num a => a -> a -> a
*a
1000000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8 -> Int
addDigit Int
n Word8
w))
                    (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> (a
mforall a. Num a => a -> a -> a
*a
100000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, ByteString
xs)

----------------------------------------------------------------

-- | A variant of 'readDecimal' which does not return the tail of
-- the string, and returns @0@ instead of @Nothing@. This is twice
-- as fast for 'Int64' on 32-bit systems, but has identical performance
-- to 'readDecimal' for all other types and architectures.
--
-- /Since: 0.4.0/
readDecimal_ :: (Integral a) => ByteString -> a
{-# SPECIALIZE readDecimal_ ::
    ByteString -> Int,
    ByteString -> Int8,
    ByteString -> Int16,
    ByteString -> Int32,
    ByteString -> Int64,
    ByteString -> Integer,
    ByteString -> Word,
    ByteString -> Word8,
    ByteString -> Word16,
    ByteString -> Word32,
    ByteString -> Word64 #-}
readDecimal_ :: forall a. Integral a => ByteString -> a
readDecimal_ = forall a. Integral a => ByteString -> a
start
    where
    start :: ByteString -> a
start ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
0
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> ByteString -> a
loop0 (forall a. Integral a => Word8 -> a
toDigit Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
0

    loop0 :: (Integral a) => a -> ByteString -> a
    loop0 :: forall a. Integral a => a -> ByteString -> a
loop0 !a
m !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
m
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop1 a
m (forall a. Integral a => Word8 -> a
toDigit Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
m

    loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8
        :: (Integral a) => a -> Int -> ByteString -> a
    loop1 :: forall a. Integral a => a -> Int -> ByteString -> a
loop1 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop2 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop2 :: forall a. Integral a => a -> Int -> ByteString -> a
loop2 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
100 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop3 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
100 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop3 :: forall a. Integral a => a -> Int -> ByteString -> a
loop3 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
1000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop4 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
1000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop4 :: forall a. Integral a => a -> Int -> ByteString -> a
loop4 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
10000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop5 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
10000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop5 :: forall a. Integral a => a -> Int -> ByteString -> a
loop5 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
100000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop6 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
100000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop6 :: forall a. Integral a => a -> Int -> ByteString -> a
loop6 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
1000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop7 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
1000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop7 :: forall a. Integral a => a -> Int -> ByteString -> a
loop7 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
10000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> Int -> ByteString -> a
loop8 a
m (Int -> Word8 -> Int
addDigit Int
n Word8
w) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
10000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    loop8 :: forall a. Integral a => a -> Int -> ByteString -> a
loop8 !a
m !Int
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = a
mforall a. Num a => a -> a -> a
*a
100000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8 -> Bool
isDecimal Word8
w -> forall a. Integral a => a -> ByteString -> a
loop0
                    (a
mforall a. Num a => a -> a -> a
*a
1000000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8 -> Int
addDigit Int
n Word8
w))
                    (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise   -> a
mforall a. Num a => a -> a -> a
*a
100000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

----------------------------------------------------------------
-- | Convert a non-negative integer into an (unsigned) ASCII decimal
-- string. Returns @Nothing@ on negative inputs.
packDecimal :: (Integral a) => a -> Maybe ByteString
{-# INLINE packDecimal #-}
packDecimal :: forall a. Integral a => a -> Maybe ByteString
packDecimal a
n
    | a
n forall a. Ord a => a -> a -> Bool
< a
0     = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Integral a => a -> ByteString
unsafePackDecimal a
n)


-- This implementation is modified from:
-- <http://www.serpentine.com/blog/2013/03/20/whats-good-for-c-is-good-for-haskell/>
-- See the banchmarks for implementation details.
-- BUG: the additional guard in 'numDecimalDigits' results in a 3x slowdown!!
--
-- | Convert a non-negative integer into an (unsigned) ASCII decimal
-- string. This function is unsafe to use on negative inputs.
unsafePackDecimal :: (Integral a) => a -> ByteString
{-# SPECIALIZE unsafePackDecimal ::
    Int     -> ByteString,
    Int8    -> ByteString,
    Int16   -> ByteString,
    Int32   -> ByteString,
    Int64   -> ByteString,
    Integer -> ByteString,
    Word    -> ByteString,
    Word8   -> ByteString,
    Word16  -> ByteString,
    Word32  -> ByteString,
    Word64  -> ByteString #-}
unsafePackDecimal :: forall a. Integral a => a -> ByteString
unsafePackDecimal a
n0 =
    let size :: Int
size = forall a. Integral a => a -> Int
numDecimalDigits a
n0
    in  Int -> (Ptr Word8 -> IO ()) -> ByteString
BSI.unsafeCreate Int
size forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
n0 (Ptr Word8
p0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size forall a. Num a => a -> a -> a
- Int
1))
    where
    getDigit :: Int -> Word8
getDigit = ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
packDecimal_digits

    loop :: a -> Ptr Word8 -> IO ()
loop !a
n !Ptr Word8
p
        | a
n forall a. Ord a => a -> a -> Bool
>= a
100  = do
            let (a
q,a
r) = a
n forall a. Integral a => a -> a -> (a, a)
`quotRem` a
100
            forall {a}. Integral a => a -> Ptr Word8 -> IO ()
write2 a
r Ptr Word8
p
            a -> Ptr Word8 -> IO ()
loop   a
q (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate Int
2)
        | a
n forall a. Ord a => a -> a -> Bool
>= a
10   = forall {a}. Integral a => a -> Ptr Word8 -> IO ()
write2 a
n Ptr Word8
p
        | Bool
otherwise = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
0x30 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)

    write2 :: p -> Ptr Word8 -> IO ()
write2 !p
i0 !Ptr Word8
p = do
        let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
i0; j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p                      (Int -> Word8
getDigit forall a b. (a -> b) -> a -> b
$! Int
j forall a. Num a => a -> a -> a
+ Int
1)
        forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate Int
1) (Int -> Word8
getDigit Int
j)

-- TODO(2021-10-23): We might should replace this with the 'Addr#'
--   hack that newer Bytestring uses for hexadecimal stuff:
--   <https://github.com/haskell/bytestring/pull/418>
packDecimal_digits :: ByteString
{-# NOINLINE packDecimal_digits #-}
packDecimal_digits :: ByteString
packDecimal_digits = String -> ByteString
BS8.pack
    String
"0001020304050607080910111213141516171819\
    \2021222324252627282930313233343536373839\
    \4041424344454647484950515253545556575859\
    \6061626364656667686970717273747576777879\
    \8081828384858687888990919293949596979899"

----------------------------------------------------------------
----------------------------------------------------------------
----- Hexadecimal

-- | Read a non-negative integral value in ASCII hexadecimal format.
-- Returns @Nothing@ if there is no integer at the beginning of the
-- string, otherwise returns @Just@ the integer read and the remainder
-- of the string.
--
-- This function does not recognize the various hexadecimal sigils
-- like \"0x\", but because there are so many different variants,
-- those are best handled by helper functions which then use this
-- function for the actual numerical parsing. This function recognizes
-- both upper-case, lower-case, and mixed-case hexadecimal.
readHexadecimal :: (Integral a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readHexadecimal ::
    ByteString -> Maybe (Int,     ByteString),
    ByteString -> Maybe (Int8,    ByteString),
    ByteString -> Maybe (Int16,   ByteString),
    ByteString -> Maybe (Int32,   ByteString),
    ByteString -> Maybe (Int64,   ByteString),
    ByteString -> Maybe (Integer, ByteString),
    ByteString -> Maybe (Word,    ByteString),
    ByteString -> Maybe (Word8,   ByteString),
    ByteString -> Maybe (Word16,  ByteString),
    ByteString -> Maybe (Word32,  ByteString),
    ByteString -> Maybe (Word64,  ByteString) #-}
readHexadecimal :: forall a. Integral a => ByteString -> Maybe (a, ByteString)
readHexadecimal = forall {t}. Num t => ByteString -> Maybe (t, ByteString)
start
    where
    -- TODO: Would it be worth trying to do the magichash trick
    -- used by Warp here? It'd really help remove branch prediction
    -- issues etc.
    --
    -- Beware the urge to make this code prettier, cf 'readDecimal'.
    start :: ByteString -> Maybe (t, ByteString)
start ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = forall a. Maybe a
Nothing
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8
0x39 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x30 ->
                    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t}. Num t => t -> ByteString -> (t, ByteString)
loop (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w forall a. Num a => a -> a -> a
- Word8
0x30))  (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Word8
0x46 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x41 ->
                    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t}. Num t => t -> ByteString -> (t, ByteString)
loop (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wforall a. Num a => a -> a -> a
-Word8
0x41forall a. Num a => a -> a -> a
+Word8
10)) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Word8
0x66 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x61 ->
                    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t}. Num t => t -> ByteString -> (t, ByteString)
loop (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wforall a. Num a => a -> a -> a
-Word8
0x61forall a. Num a => a -> a -> a
+Word8
10)) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise -> forall a. Maybe a
Nothing

    loop :: t -> ByteString -> (t, ByteString)
loop !t
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (t
n, ByteString
BS.empty) -- not @xs@, to help GC
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8
0x39 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x30 ->
                    t -> ByteString -> (t, ByteString)
loop (t
nforall a. Num a => a -> a -> a
*t
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w forall a. Num a => a -> a -> a
- Word8
0x30))  (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Word8
0x46 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x41 ->
                    t -> ByteString -> (t, ByteString)
loop (t
nforall a. Num a => a -> a -> a
*t
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wforall a. Num a => a -> a -> a
-Word8
0x41forall a. Num a => a -> a -> a
+Word8
10)) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Word8
0x66 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x61 ->
                    t -> ByteString -> (t, ByteString)
loop (t
nforall a. Num a => a -> a -> a
*t
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
wforall a. Num a => a -> a -> a
-Word8
0x61forall a. Num a => a -> a -> a
+Word8
10)) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise -> (t
n,ByteString
xs)


-- | Convert a non-negative integer into a lower-case ASCII hexadecimal
-- string. Returns @Nothing@ on negative inputs.
packHexadecimal :: (Integral a) => a -> Maybe ByteString
{-# INLINE packHexadecimal #-}
packHexadecimal :: forall a. Integral a => a -> Maybe ByteString
packHexadecimal a
n
    | a
n forall a. Ord a => a -> a -> Bool
< a
0     = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Integral a => a -> ByteString
unsafePackHexadecimal a
n)


-- | Convert a non-negative integer into a lower-case ASCII hexadecimal
-- string. This function is unsafe to use on negative inputs.
unsafePackHexadecimal :: (Integral a) => a -> ByteString
{-# SPECIALIZE unsafePackHexadecimal ::
    Int     -> ByteString,
    Int8    -> ByteString,
    Int16   -> ByteString,
    Int32   -> ByteString,
    Int64   -> ByteString,
    Integer -> ByteString,
    Word    -> ByteString,
    Word8   -> ByteString,
    Word16  -> ByteString,
    Word32  -> ByteString,
    Word64  -> ByteString #-}
unsafePackHexadecimal :: forall a. Integral a => a -> ByteString
unsafePackHexadecimal a
n0 =
    let size :: Int
size = forall a. (Integral a, Bits a) => Int -> a -> Int
numTwoPowerDigits Int
4 (forall a. Integral a => a -> Integer
toInteger a
n0) -- for Bits
    in  Int -> (Ptr Word8 -> IO ()) -> ByteString
BSI.unsafeCreate Int
size forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 ->
            forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
n0 (Ptr Word8
p0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size forall a. Num a => a -> a -> a
- Int
1))
    where
    -- TODO: benchmark using @hexDigits@ vs using direct manipulations.
    loop :: (Integral a) => a -> Ptr Word8 -> IO ()
    loop :: forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
n Ptr Word8
p
        | a
n forall a. Ord a => a -> a -> Bool
<= a
15   = do
            forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
hexDigits (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Bits a => a -> a -> a
.&. Int
0x0F))
        | Bool
otherwise = do
            let (a
q,a
r) = a
n forall a. Integral a => a -> a -> (a, a)
`quotRem` a
16
            forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
hexDigits (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r forall a. Bits a => a -> a -> a
.&. Int
0x0F))
            forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
q (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate Int
1)


-- Inspired by, <http://forums.xkcd.com/viewtopic.php?f=11&t=16666&p=553936>
-- | Convert a bitvector into a lower-case ASCII hexadecimal string.
-- This is helpful for visualizing raw binary data, rather than for
-- parsing as such.
asHexadecimal :: ByteString -> ByteString
asHexadecimal :: ByteString -> ByteString
asHexadecimal = ByteString -> ByteString
start
    where
    start :: ByteString -> ByteString
start ByteString
buf
        | ByteString -> Int
BS.length ByteString
buf forall a. Ord a => a -> a -> Bool
> forall a. Bounded a => a
maxBound forall a. Integral a => a -> a -> a
`quot` Int
2 =
            forall a. HasCallStack => String -> a
error String
_asHexadecimal_overflow
        | Bool
otherwise =
            Int -> (Ptr Word8 -> IO ()) -> ByteString
BSI.unsafeCreate (Int
2 forall a. Num a => a -> a -> a
* ByteString -> Int
BS.length ByteString
buf) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> do
                Ptr Word8
_ <- forall a. (a -> Word8 -> IO a) -> a -> ByteString -> IO a
foldIO Ptr Word8 -> Word8 -> IO (Ptr Word8)
step Ptr Word8
p0 ByteString
buf
                forall (m :: * -> *) a. Monad m => a -> m a
return () -- needed for type checking

    step :: Ptr Word8 -> Word8 -> IO (Ptr Word8)
    step :: Ptr Word8 -> Word8 -> IO (Ptr Word8)
step !Ptr Word8
p !Word8
w = do
        let ix :: Int
ix = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
        forall a. Storable a => Ptr a -> a -> IO ()
poke   Ptr Word8
p     (ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
hexDigits ((Int
ix forall a. Bits a => a -> a -> a
.&. Int
0xF0) forall a. Bits a => a -> Int -> a
`shiftR` Int
4))
        forall a. Storable a => Ptr a -> a -> IO ()
poke   (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
hexDigits  (Int
ix forall a. Bits a => a -> a -> a
.&. Int
0x0F))
        forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)

_asHexadecimal_overflow :: String
{-# NOINLINE _asHexadecimal_overflow #-}
_asHexadecimal_overflow :: String
_asHexadecimal_overflow =
    String
"asHexadecimal: cannot create buffer larger than (maxBound::Int)"


-- TODO: benchmark against the magichash hack used in Warp.
-- TODO(2021-10-23): Benchmark against the 'Addr#' hack that newer
--   Bytestring uses for hexadecimal stuff:
--   <https://github.com/haskell/bytestring/pull/418>
--
-- | The lower-case ASCII hexadecimal digits, in numerical order
-- for use as a lookup table.
hexDigits :: ByteString
{-# NOINLINE hexDigits #-}
hexDigits :: ByteString
hexDigits = String -> ByteString
BS8.pack String
"0123456789abcdef"


-- | We can only do this for MonadIO not just any Monad, but that's
-- good enough for what we need...
foldIO :: (a -> Word8 -> IO a) -> a -> ByteString -> IO a
{-# INLINE foldIO #-}
foldIO :: forall a. (a -> Word8 -> IO a) -> a -> ByteString -> IO a
foldIO a -> Word8 -> IO a
f a
z0 (BSI.PS ForeignPtr Word8
fp Int
off Int
len) =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
FFI.withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> do
        let q :: Ptr b
q = Ptr Word8
p0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offforall a. Num a => a -> a -> a
+Int
len)
        let go :: a -> Ptr Word8 -> IO a
go !a
z !Ptr Word8
p
                | Ptr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
q    = forall (m :: * -> *) a. Monad m => a -> m a
return a
z
                | Bool
otherwise = do
                    Word8
w  <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
                    a
z' <- a -> Word8 -> IO a
f a
z Word8
w
                    a -> Ptr Word8 -> IO a
go a
z' (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        a -> Ptr Word8 -> IO a
go a
z0 (Ptr Word8
p0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)


----------------------------------------------------------------
----------------------------------------------------------------
----- Octal

-- | Read a non-negative integral value in ASCII octal format.
-- Returns @Nothing@ if there is no integer at the beginning of the
-- string, otherwise returns @Just@ the integer read and the remainder
-- of the string.
--
-- This function does not recognize the various octal sigils like
-- \"0o\", but because there are different variants, those are best
-- handled by helper functions which then use this function for the
-- actual numerical parsing.
readOctal :: (Integral a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readOctal ::
    ByteString -> Maybe (Int,     ByteString),
    ByteString -> Maybe (Int8,    ByteString),
    ByteString -> Maybe (Int16,   ByteString),
    ByteString -> Maybe (Int32,   ByteString),
    ByteString -> Maybe (Int64,   ByteString),
    ByteString -> Maybe (Integer, ByteString),
    ByteString -> Maybe (Word,    ByteString),
    ByteString -> Maybe (Word8,   ByteString),
    ByteString -> Maybe (Word16,  ByteString),
    ByteString -> Maybe (Word32,  ByteString),
    ByteString -> Maybe (Word64,  ByteString) #-}
readOctal :: forall a. Integral a => ByteString -> Maybe (a, ByteString)
readOctal = forall {t}. Num t => ByteString -> Maybe (t, ByteString)
start
    where
    start :: ByteString -> Maybe (t, ByteString)
start ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = forall a. Maybe a
Nothing
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8
0x37 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x30 ->
                    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t}. Num t => t -> ByteString -> (t, ByteString)
loop (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w forall a. Num a => a -> a -> a
- Word8
0x30)) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise -> forall a. Maybe a
Nothing

    loop :: t -> ByteString -> (t, ByteString)
loop !t
n !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs = (t
n, ByteString
BS.empty) -- not @xs@, to help GC
        | Bool
otherwise  =
            case ByteString -> Word8
BSU.unsafeHead ByteString
xs of
            Word8
w | Word8
0x37 forall a. Ord a => a -> a -> Bool
>= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x30 ->
                    t -> ByteString -> (t, ByteString)
loop (t
n forall a. Num a => a -> a -> a
* t
8 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w forall a. Num a => a -> a -> a
- Word8
0x30)) (ByteString -> ByteString
BSU.unsafeTail ByteString
xs)
              | Bool
otherwise -> (t
n,ByteString
xs)


-- | Convert a non-negative integer into an ASCII octal string.
-- Returns @Nothing@ on negative inputs.
packOctal :: (Integral a) => a -> Maybe ByteString
{-# INLINE packOctal #-}
packOctal :: forall a. Integral a => a -> Maybe ByteString
packOctal a
n
    | a
n forall a. Ord a => a -> a -> Bool
< a
0     = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. Integral a => a -> ByteString
unsafePackOctal a
n)


-- | Convert a non-negative integer into an ASCII octal string.
-- This function is unsafe to use on negative inputs.
unsafePackOctal :: (Integral a) => a -> ByteString
{-# SPECIALIZE unsafePackOctal ::
    Int     -> ByteString,
    Int8    -> ByteString,
    Int16   -> ByteString,
    Int32   -> ByteString,
    Int64   -> ByteString,
    Integer -> ByteString,
    Word    -> ByteString,
    Word8   -> ByteString,
    Word16  -> ByteString,
    Word32  -> ByteString,
    Word64  -> ByteString #-}
unsafePackOctal :: forall a. Integral a => a -> ByteString
unsafePackOctal a
n0 =
    let size :: Int
size = forall a. (Integral a, Bits a) => Int -> a -> Int
numTwoPowerDigits Int
3 (forall a. Integral a => a -> Integer
toInteger a
n0) -- for Bits
    in  Int -> (Ptr Word8 -> IO ()) -> ByteString
BSI.unsafeCreate Int
size forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 ->
            forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
n0 (Ptr Word8
p0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size forall a. Num a => a -> a -> a
- Int
1))
    where
    loop :: (Integral a) => a -> Ptr Word8 -> IO ()
    loop :: forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
n Ptr Word8
p
        | a
n forall a. Ord a => a -> a -> Bool
<= a
7    = do
            forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
0x30 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
        | Bool
otherwise = do
            let (a
q,a
r) = a
n forall a. Integral a => a -> a -> (a, a)
`quotRem` a
8
            forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8
0x30 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r)
            forall {a}. Integral a => a -> Ptr Word8 -> IO ()
loop a
q (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate Int
1)

{-
-- BUG: This doesn't quite work right...
asOctal :: ByteString -> ByteString
asOctal buf =
    BSI.unsafeCreate (ceilEightThirds $ BS.length buf) $ \p0 -> do
        let (BSI.PS fq off len) = buf
        FFI.withForeignPtr fq $ \q0 -> do
            let qF = q0 `plusPtr` (off + len - rem len 3)
            let loop :: Ptr Word8 -> Ptr Word8 -> IO ()
                loop p q
                    | q /= qF   = do
                        {- Take three Word8s and write 8 chars at a time -}
                        i <- peek q
                        j <- peek (q `plusPtr` 1) :: IO Word8
                        k <- peek (q `plusPtr` 2) :: IO Word8
                        let w =     fromIntegral i
                                .|. (fromIntegral j `shiftL` 8)
                                .|. (fromIntegral k `shiftL` 16)
                        poke p               (toC8( w              .&. 0x07))
                        poke (p `plusPtr` 1) (toC8((w `shiftR`  3) .&. 0x07))
                        poke (p `plusPtr` 2) (toC8((w `shiftR`  6) .&. 0x07))
                        poke (p `plusPtr` 3) (toC8((w `shiftR`  9) .&. 0x07))
                        poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07))
                        poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x07))
                        poke (p `plusPtr` 6) (toC8((w `shiftR` 18) .&. 0x07))
                        poke (p `plusPtr` 7) (toC8((w `shiftR` 21) .&. 0x07))
                        loop (p `plusPtr` 8) (q `plusPtr` 3)
                    | 2 == rem len 3 = do
                        {- Handle the last two Word8s -}
                        i <- peek q
                        j <- peek (q `plusPtr` 1) :: IO Word8
                        let w =      fromIntegral i
                                .|. (fromIntegral j `shiftL` 8)
                        poke p               (toC8( w              .&. 0x07))
                        poke (p `plusPtr` 1) (toC8((w `shiftR`  3) .&. 0x07))
                        poke (p `plusPtr` 2) (toC8((w `shiftR`  6) .&. 0x07))
                        poke (p `plusPtr` 3) (toC8((w `shiftR`  9) .&. 0x07))
                        poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07))
                        poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x01))
                    | otherwise = do
                        {- Handle the last Word8 -}
                        i <- peek q
                        let w = fromIntegral i
                        poke p               (toC8( w              .&. 0x07))
                        poke (p `plusPtr` 1) (toC8((w `shiftR`  3) .&. 0x07))
                        poke (p `plusPtr` 2) (toC8((w `shiftR`  6) .&. 0x03))
            --
            loop p0 (q0 `plusPtr` off)
    where
    toC8 :: Int -> Word8
    toC8 i = fromIntegral (0x30+i)
    {-# INLINE toC8 #-}
    -- We can probably speed that up by using (.|.) in lieu of (+)

    -- See the benchmark file for credits and implementation details.
    ceilEightThirds x
        | x >= 3*(b-1) = error _asOctal_overflow
        | x >= b       = ceiling (fromIntegral x / 3 * 8 :: Double)
        | otherwise    = (x*8 + 2) `quot` 3
        where
        {-# INLINE b #-}
        b = 2^(28::Int)::Int -- b*8-1 is the last positive number for Int=Int32
        -- TODO: need to generalize for Int=Int64

_asOctal_overflow :: String
{-# NOINLINE _asOctal_overflow #-}
_asOctal_overflow =
    "asOctal: cannot create buffer larger than (maxBound::Int)"
-- -}

----------------------------------------------------------------
----------------------------------------------------------- fin.