{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
{-# LANGUAGE MagicHash    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module:      TextShow.Data.Array.Byte
Copyright:   (C) 2022 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Provides a 'TextShow' instance for 'ByteArray' from the "Data.Array.Byte"
module. Only provided if using @base-4.17.0.0@ or later.

/Since: 3.10/
-}
module TextShow.Data.Array.Byte () where

#if MIN_VERSION_base(4,17,0)
import           Data.Array.Byte (ByteArray(..))
import           Data.Bits (Bits(..))
import           Data.Char (intToDigit)
import           Data.Text.Lazy.Builder (Builder, fromString, singleton)

import           GHC.Exts (Int(..), indexWord8Array#, sizeofByteArray#)
import           GHC.Word (Word8(..))

import           Prelude ()
import           Prelude.Compat

import           TextShow.Classes (TextShow(..))

-- | /Since: 3.10/
instance TextShow ByteArray where
  showbPrec :: Int -> ByteArray -> Builder
showbPrec Int
_ ByteArray
ba =
      String -> Builder
fromString String
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
go Int
0
    where
      showW8 :: Word8 -> Builder
      showW8 :: Word8 -> Builder
showW8 !Word8
w =
           Char -> Builder
singleton Char
'0'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'x'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton (Int -> Char
intToDigit (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
w Int
4)))
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton (Int -> Char
intToDigit (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F)))
      go :: Int -> Builder
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteArray -> Int
sizeofByteArray ByteArray
ba = Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
showW8 (ByteArray -> Int -> Word8
indexByteArray ByteArray
ba Int
i :: Word8) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        | Bool
otherwise              = Char -> Builder
singleton Char
']'
        where
          comma :: Builder
comma | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Builder
forall a. Monoid a => a
mempty
                | Bool
otherwise = String -> Builder
fromString String
", "

-- | Read byte at specific index.
indexByteArray :: ByteArray -> Int -> Word8
{-# INLINE indexByteArray #-}
indexByteArray :: ByteArray -> Int -> Word8
indexByteArray (ByteArray ByteArray#
arr#) (I# Int#
i#) = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
arr# Int#
i#)

-- | Size of the byte array in bytes.
sizeofByteArray :: ByteArray -> Int
{-# INLINE sizeofByteArray #-}
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (ByteArray ByteArray#
arr#) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr#)
#endif