{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
module Data.ByteString.Base32.Internal.Utils
( aix
, peekWord32BE
, peekWord64BE
, reChunkN
, w32
, w64
, w64_32
, writeNPlainPtrBytes
) where


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

import Foreign.Ptr
import Foreign.Storable

import GHC.ByteOrder
import GHC.Exts
import GHC.Word

import System.IO.Unsafe
import Foreign.Marshal.Alloc (mallocBytes)


-- | Read 'Word8' index off alphabet addr
--
aix :: Word8 -> Addr# -> Word8
aix :: Word8 -> Addr# -> Word8
aix (W8# Word#
i) 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_32 :: Word32 -> Word64
w64_32 :: Word32 -> Word64
w64_32 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w64_32 #-}

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
--
writeNPlainPtrBytes
  :: Storable a
  => Int
  -> [a]
  -> Ptr a
writeNPlainPtrBytes :: Int -> [a] -> Ptr a
writeNPlainPtrBytes !Int
n [a]
as = IO (Ptr a) -> Ptr a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Ptr a) -> Ptr a) -> IO (Ptr a) -> Ptr a
forall a b. (a -> b) -> a -> b
$ do
    Ptr a
p <- Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes Int
n
    Ptr a -> [a] -> IO ()
forall b. Storable b => Ptr b -> [b] -> IO ()
go Ptr a
p [a]
as
    Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
p
  where
    go :: Ptr b -> [b] -> IO ()
go !Ptr b
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go !Ptr b
p (b
x:[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 Int
1) [b]
xs
{-# INLINE writeNPlainPtrBytes #-}

peekWord32BE :: Ptr Word32 -> IO Word32
peekWord32BE :: Ptr Word32 -> IO Word32
peekWord32BE Ptr Word32
p = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
p
  ByteOrder
BigEndian -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
p
{-# inline peekWord32BE #-}

peekWord64BE :: Ptr Word64 -> IO Word64
peekWord64BE :: Ptr Word64 -> IO Word64
peekWord64BE Ptr Word64
p = case ByteOrder
targetByteOrder of
  ByteOrder
LittleEndian -> Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
p
  ByteOrder
BigEndian -> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
p
{-# inline peekWord64BE #-}

-- | Rechunk a list of bytestrings in multiples of @n@
--
reChunkN :: Int -> [ByteString] -> [ByteString]
reChunkN :: Int -> [ByteString] -> [ByteString]
reChunkN Int
n = [ByteString] -> [ByteString]
go
  where
    go :: [ByteString] -> [ByteString]
go [] = []
    go (ByteString
b:[ByteString]
bs) = case Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (ByteString -> Int
BS.length ByteString
b) Int
n of
      (Int
_, Int
0) -> ByteString
b ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
go [ByteString]
bs
      (Int
d, Int
_) -> case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) ByteString
b of
        ~(ByteString
h, ByteString
t) -> ByteString
h ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
accum ByteString
t [ByteString]
bs

    accum :: ByteString -> [ByteString] -> [ByteString]
accum ByteString
acc [] = [ByteString
acc]
    accum ByteString
acc (ByteString
c:[ByteString]
cs) =
      case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
acc) ByteString
c of
        ~(ByteString
h, ByteString
t) ->
          let acc' :: ByteString
acc' = ByteString -> ByteString -> ByteString
BS.append ByteString
acc ByteString
h
          in if ByteString -> Int
BS.length ByteString
acc' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
             then
               let cs' :: [ByteString]
cs' = if ByteString -> Bool
BS.null ByteString
t then [ByteString]
cs else ByteString
t ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
cs
               in ByteString
acc' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
go [ByteString]
cs'
             else ByteString -> [ByteString] -> [ByteString]
accum ByteString
acc' [ByteString]
cs
{-# INLINE reChunkN #-}