-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>

module Data.Text.Builder.Linear.Hex
  ( (|>&)
  , (&<|)
  ) where

import Data.Bits (FiniteBits(..), Bits(..))
import Data.Foldable (forM_)
import qualified Data.Text.Array as A
import GHC.Exts (Int(..), (>#), (<=#))
import GHC.ST (ST)

import Data.Text.Builder.Linear.Core

-- | Append hexadecimal number.
(|>&) :: (Integral a, FiniteBits a) => Buffer ⊸ a → Buffer
infixl 6 |>&
Buffer
buffer |>& :: forall a. (Integral a, FiniteBits a) => Buffer %1 -> a -> Buffer
|>& a
n = Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded
  (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendHex MArray s
dst Int
dstOff a
n)
  Buffer
buffer
{-# INLINABLE (|>&) #-}

-- | Prepend hexadecimal number.
(&<|) :: (Integral a, FiniteBits a) => a → Buffer ⊸ Buffer
infixr 6 &<|
a
n &<| :: forall a. (Integral a, FiniteBits a) => a -> Buffer %1 -> Buffer
&<| Buffer
buffer = Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded
  (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependHex MArray s
dst Int
dstOff a
n)
  (\MArray s
dst Int
dstOff → MArray s -> Int -> a -> ST s Int
forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendHex MArray s
dst Int
dstOff a
n)
  Buffer
buffer
{-# INLINABLE (&<|) #-}

unsafeAppendHex :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int
unsafeAppendHex :: forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafeAppendHex MArray s
marr Int
off a
n = do
  let len :: Int
len = a -> Int
forall b. FiniteBits b => b -> Int
lengthAsHex a
n
  [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i →
    let nibble :: a
nibble = (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` ((Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2)) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xf in
      MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Int -> ST s ()
writeNibbleAsHex MArray s
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nibble)
  Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
len
{-# INLINABLE unsafeAppendHex #-}

unsafePrependHex :: (Integral a, FiniteBits a) => A.MArray s → Int → a → ST s Int
unsafePrependHex :: forall a s.
(Integral a, FiniteBits a) =>
MArray s -> Int -> a -> ST s Int
unsafePrependHex MArray s
marr Int
off a
n = do
  let len :: Int
len = a -> Int
forall b. FiniteBits b => b -> Int
lengthAsHex a
n
  [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i →
    let nibble :: a
nibble = (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` (Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2)) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xf in
      MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Int -> ST s ()
writeNibbleAsHex MArray s
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nibble)
  Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
len
{-# INLINABLE unsafePrependHex #-}

lengthAsHex :: FiniteBits a => a → Int
lengthAsHex :: forall b. FiniteBits b => b -> Int
lengthAsHex a
n = Int -> Int
max1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros a
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
{-# INLINABLE lengthAsHex #-}

-- Branchless equivalent for max 1 n.
max1 :: Int → Int
max1 :: Int -> Int
max1 n :: Int
n@(I# Int#
n#) = Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int# -> Int
I# (Int#
n# Int# -> Int# -> Int#
<=# Int#
0#)

writeNibbleAsHex :: A.MArray s → Int → Int → ST s ()
writeNibbleAsHex :: forall s. MArray s -> Int -> Int -> ST s ()
writeNibbleAsHex MArray s
marr Int
off n :: Int
n@(I# Int#
n#) = MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
off (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hex)
  where
    hex :: Int
hex = Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# (Int#
n# Int# -> Int# -> Int#
># Int#
9#) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
39