{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
module Data.ByteString.Base16.Internal.Utils
( aix
, w32
, w64
, reChunk
, writeNPlainForeignPtrBytes
) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as B

import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable

import GHC.Exts
import GHC.ForeignPtr
import GHC.Word

import System.IO.Unsafe


-- | 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 #-}

w32 :: Word8 -> Word32
w32 :: Word8 -> Word32
w32 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w32 #-}

w64 :: Word8 -> Word64
w64 :: Word8 -> Word64
w64 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w64 #-}

-- | Allocate and fill @n@ bytes with some data
--
writeNPlainForeignPtrBytes
    :: ( Storable a
       , Storable b
       )
    => Int
    -> [a]
    -> ForeignPtr b
writeNPlainForeignPtrBytes :: Int -> [a] -> ForeignPtr b
writeNPlainForeignPtrBytes !Int
n as :: [a]
as = IO (ForeignPtr b) -> ForeignPtr b
forall a. IO a -> a
unsafeDupablePerformIO (IO (ForeignPtr b) -> ForeignPtr b)
-> IO (ForeignPtr b) -> ForeignPtr b
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr a
fp <- Int -> IO (ForeignPtr a)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
n
    ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \p :: Ptr a
p -> Ptr a -> [a] -> IO ()
forall b. Storable b => Ptr b -> [b] -> IO ()
go Ptr a
p [a]
as
    ForeignPtr b -> IO (ForeignPtr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a -> ForeignPtr b
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr a
fp)
  where
    go :: Ptr b -> [b] -> IO ()
go !Ptr b
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !Ptr b
p (x :: b
x:xs :: [b]
xs) = Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
p b
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> [b] -> IO ()
go (Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr b
p 1) [b]
xs

-- | 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