{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.ByteString.Base16.Internal.Utils
( aix
, reChunk
, runShortST
, runDecodeST
) where


import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Short.Internal
import Data.Primitive.ByteArray
import Data.Text (Text)

import GHC.Exts
import GHC.Word
import GHC.ST (ST(..))


-- | Read 'Word8' index off alphabet addr
--
aix :: Word8 -> Addr# -> Word8
aix :: Word8 -> Addr# -> Word8
aix (W8# i :: Word#
i) alpha :: Addr#
alpha = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
alpha (Word# -> Int#
word2Int# Word#
i))
{-# INLINE aix #-}

-- | Form a list of chunks, and rechunk the list of bytestrings
-- into length multiples of 2
--
reChunk :: [ByteString] -> [ByteString]
reChunk :: [ByteString] -> [ByteString]
reChunk [] = []
reChunk (c :: ByteString
c:cs :: [ByteString]
cs) = case ByteString -> Int
B.length ByteString
c Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 2 of
    (_, 0) -> ByteString
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
reChunk [ByteString]
cs
    (n :: Int
n, _) -> case Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2) ByteString
c of
      ~(m :: ByteString
m, q :: ByteString
q) -> ByteString
m ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
cont_ ByteString
q [ByteString]
cs
  where
    cont_ :: ByteString -> [ByteString] -> [ByteString]
cont_ q :: ByteString
q [] = [ByteString
q]
    cont_ q :: ByteString
q (a :: ByteString
a:as :: [ByteString]
as) = case Int -> ByteString -> (ByteString, ByteString)
B.splitAt 1 ByteString
a of
      ~(x :: ByteString
x, y :: ByteString
y) -> let q' :: ByteString
q' = ByteString -> ByteString -> ByteString
B.append ByteString
q ByteString
x
        in if ByteString -> Int
B.length ByteString
q' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2
          then
            let as' :: [ByteString]
as' = if ByteString -> Bool
B.null ByteString
y then [ByteString]
as else ByteString
yByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
as
            in ByteString
q' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
reChunk [ByteString]
as'
          else ByteString -> [ByteString] -> [ByteString]
cont_ ByteString
q' [ByteString]
as

-- | Write a byte array directly to Short bytestring
--
runShortST :: (forall s. ST s ByteArray) -> ShortByteString
runShortST :: (forall s. ST s ByteArray) -> ShortByteString
runShortST enc :: forall s. ST s ByteArray
enc = (State# RealWorld -> ShortByteString) -> ShortByteString
forall o. (State# RealWorld -> o) -> o
runRW# ((State# RealWorld -> ShortByteString) -> ShortByteString)
-> (State# RealWorld -> ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ \s0 :: State# RealWorld
s0 -> case ST RealWorld ByteArray
forall s. ST s ByteArray
enc of
  { ST g :: STRep RealWorld ByteArray
g -> case STRep RealWorld ByteArray
g State# RealWorld
s0 of
    { (# _, ByteArray r :: ByteArray#
r #) -> ByteArray# -> ShortByteString
SBS ByteArray#
r
    }
  }
{-# INLINE runShortST #-}

-- | Used for writing 'ByteArray#'-based encodes
--
runDecodeST
    :: (forall s. ST s (Either Text ByteArray))
    -> Either Text ShortByteString
runDecodeST :: (forall s. ST s (Either Text ByteArray))
-> Either Text ShortByteString
runDecodeST dec :: forall s. ST s (Either Text ByteArray)
dec = (State# RealWorld -> Either Text ShortByteString)
-> Either Text ShortByteString
forall o. (State# RealWorld -> o) -> o
runRW# ((State# RealWorld -> Either Text ShortByteString)
 -> Either Text ShortByteString)
-> (State# RealWorld -> Either Text ShortByteString)
-> Either Text ShortByteString
forall a b. (a -> b) -> a -> b
$ \s0 :: State# RealWorld
s0 -> case ST RealWorld (Either Text ByteArray)
forall s. ST s (Either Text ByteArray)
dec of
  { ST g :: STRep RealWorld (Either Text ByteArray)
g -> case STRep RealWorld (Either Text ByteArray)
g State# RealWorld
s0 of
    { (# _, e :: Either Text ByteArray
e #) -> case Either Text ByteArray
e of
      Left t :: Text
t -> Text -> Either Text ShortByteString
forall a b. a -> Either a b
Left Text
t
      Right (ByteArray r :: ByteArray#
r) -> ShortByteString -> Either Text ShortByteString
forall a b. b -> Either a b
Right (ByteArray# -> ShortByteString
SBS ByteArray#
r)
    }
  }
{-# INLINE runDecodeST #-}