    -- |
    -- Copyright:   (c) 2022 Andrew Lelechenko
    -- Licence:     BSD3
    -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
    module Data.Text.Builder.Linear.Hex (
      (|>&),
      (&<|),
    ) where

    import Data.Bits (Bits (..), FiniteBits (..))
    import Data.Text.Array qualified as A
    import Data.Word (Word16, Word32, Word64, Word8)
    import GHC.Exts (Int (..), (>#))
    import GHC.ST (ST)

    import Data.Text.Builder.Linear.Core

    -- | Append the lower-case hexadecimal representation of a /bounded/ integral
    -- number.
    --
    -- Negative numbers are interpreted as their corresponding unsigned number:
    --
    -- >>> :set -XOverloadedStrings -XLinearTypes
    -- >>> import Data.Int (Int8, Int16)
    -- >>> runBuffer (\b -> b |>& (-1 :: Int8)) == "ff"
    -- True
    -- >>> runBuffer (\b -> b |>& (-1 :: Int16)) == "ffff"
    -- True
    (|>&) ∷ (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 a. (Integral a, FiniteBits a) => a -> Int
    maxHexLen 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
    {-# INLINEABLE (|>&) #-}

    -- | Prepend the lower-case hexadecimal representation of a /bounded/ integral
    -- number.
    --
    -- Negative numbers are interpreted as their corresponding unsigned number:
    --
    -- >>> :set -XOverloadedStrings -XLinearTypes
    -- >>> import Data.Int (Int8, Int16)
    -- >>> runBuffer (\b -> (-1 :: Int8) &<| b) == "ff"
    -- True
    -- >>> runBuffer (\b -> (-1 :: Int16) &<| b) == "ffff"
    -- True
    (&<|) ∷ (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 a. (Integral a, FiniteBits a) => a -> Int
    maxHexLen 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
    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
    {-# INLINEABLE (&<|) #-}

    -- | Compute the number of nibbles that an integral type can hold, rounded up.
    maxHexLen ∷ (Integral a, FiniteBits a) ⇒ a → Int
    maxHexLen :: forall a. (Integral a, FiniteBits a) => a -> Int
    maxHexLen a
    n = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ((a -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize a
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    2)
    {-# INLINEABLE maxHexLen #-}

    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
    0 =
      MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr Int
    off Word8
    0x30 ST s () -> ST s Int -> ST s Int
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    1
    unsafeAppendHex MArray s
    marr !Int
    off a
    n = Int -> a -> ST s Int
    go (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) a
    n
      where
        len :: Int
    len = a -> Int
    forall b. FiniteBits b => b -> Int
    lengthAsHex a
    n

        go :: Int -> a -> ST s Int
    go !Int
    _ a
    0 = Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    len
        go !Int
    o a
    m = do
          let nibble :: a
    nibble = a
    m a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    0x0f
          MArray s -> Int -> Int -> ST s ()
    forall s. MArray s -> Int -> Int -> ST s ()
    writeNibbleAsHex MArray s
    marr Int
    o (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    nibble)
          Int -> a -> ST s Int
    go (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (a -> a
    forall a. (Integral a, FiniteBits a) => a -> a
    dropNibble a
    m)
    {-# INLINEABLE 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
    0 =
      MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    0x30 ST s () -> ST s Int -> ST s Int
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    1
    unsafePrependHex MArray s
    marr !Int
    off a
    n = Int -> a -> ST s Int
    go (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) a
    n
      where
        go :: Int -> a -> ST s Int
    go !Int
    o a
    0 = Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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
    o)
        go !Int
    o a
    m = do
          let nibble :: a
    nibble = a
    m a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    0x0f
          MArray s -> Int -> Int -> ST s ()
    forall s. MArray s -> Int -> Int -> ST s ()
    writeNibbleAsHex MArray s
    marr Int
    o (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    nibble)
          Int -> a -> ST s Int
    go (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (a -> a
    forall a. (Integral a, FiniteBits a) => a -> a
    dropNibble a
    m)
    {-# INLINEABLE unsafePrependHex #-}

    -- | The usual 'shiftR' performs sign extension on signed number types,
    -- filling the top bits with 1 if the argument is negative.
    -- We don't want this behaviour here.
    --
    -- It would suffice to clean the sign bit only once
    -- instead of doing it on every iteration of unsafe{Ap,Pre}pendHex.go,
    -- but the performance impact is likely negligible.
    dropNibble ∷ (Integral a, FiniteBits a) ⇒ a → a
    dropNibble :: forall a. (Integral a, FiniteBits a) => a -> a
    dropNibble a
    x = case (a -> Bool
    forall a. Bits a => a -> Bool
    isSigned a
    x, a -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize a
    x) of
      -- This is morally 'iShiftRL#', 'uncheckedIShiftRA64#', etc.,
      -- but there is no polymorphic interface to access them.
      (Bool
    True, Int
    8) → forall a b. (Integral a, Num b) => a -> b
    fromIntegral @Word8 (Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    shiftR (a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x) Int
    4)
      (Bool
    True, Int
    16) → forall a b. (Integral a, Num b) => a -> b
    fromIntegral @Word16 (Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    shiftR (a -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x) Int
    4)
      (Bool
    True, Int
    32) → forall a b. (Integral a, Num b) => a -> b
    fromIntegral @Word32 (Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    shiftR (a -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x) Int
    4)
      (Bool
    True, Int
    64) → forall a b. (Integral a, Num b) => a -> b
    fromIntegral @Word64 (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    shiftR (a -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x) Int
    4)
      (Bool
    True, Int
    _) → a -> Int -> a
    forall a. Bits a => a -> Int -> a
    shiftR a
    x Int
    4 a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. ((a
    1 a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` (a -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize a
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4)) a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1)
      (Bool, Int)
    _ → a -> Int -> a
    forall a. Bits a => a -> Int -> a
    shiftR a
    x Int
    4
    {-# INLINE dropNibble #-}

    -- | This assumes n /= 0. Round the number of nibbles up, as in 'maxHexLen'.
    lengthAsHex ∷ FiniteBits a ⇒ a → Int
    lengthAsHex :: forall b. FiniteBits b => b -> Int
    lengthAsHex a
    n = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    shiftR (a -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize a
    n 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. Num a => a -> a -> a
    - Int
    1) Int
    2
    {-# INLINEABLE lengthAsHex #-}

    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
    0x30 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
    0x60 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    0x39)