{-# LANGUAGE ForeignFunctionInterface #-}

module Network.HPACK.Huffman.ByteString (
    unpack4bits,
    copy,
) where

import Foreign.C.Types (CSize (..))
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (peek)
import System.IO.Unsafe (unsafeDupablePerformIO)

import Imports

-- $setup
-- >>> import qualified Data.ByteString as BS

-- |
--
-- >>> let bs = BS.pack [0x12,0x34,0xf3,0xab]
-- >>> unpack4bits bs
-- [1,2,3,4,15,3,10,11]
-- >>> unpack4bits $ BS.tail bs
-- [3,4,15,3,10,11]
unpack4bits :: ByteString -> [Word8]
unpack4bits :: ByteString -> [Word8]
unpack4bits (PS ForeignPtr Word8
fptr Int
off Int
len) = IO [Word8] -> [Word8]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Word8] -> [Word8]) -> IO [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$
    ForeignPtr Word8 -> (Ptr Word8 -> IO [Word8]) -> IO [Word8]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO [Word8]) -> IO [Word8])
-> (Ptr Word8 -> IO [Word8]) -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
        let lim :: Ptr b
lim = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            end :: Ptr b
end = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (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)
        Ptr Word8 -> Ptr Word8 -> [Word8] -> IO [Word8]
forall {b}.
(Storable b, Num b, Bits b) =>
Ptr b -> Ptr b -> [b] -> IO [b]
go Ptr Word8
forall {b}. Ptr b
lim Ptr Word8
forall {b}. Ptr b
end []
  where
    go :: Ptr b -> Ptr b -> [b] -> IO [b]
go Ptr b
lim Ptr b
p [b]
ws
        | Ptr b
lim Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr b
p = [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
ws
        | Bool
otherwise = do
            b
w <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
            let w0 :: b
w0 = b
w b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
                w1 :: b
w1 = b
w b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
0xf
            Ptr b -> Ptr b -> [b] -> IO [b]
go Ptr b
lim (Ptr b
p Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (b
w0 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: b
w1 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ws)

copy :: Ptr Word8 -> ByteString -> IO ()
copy :: Ptr Word8 -> ByteString -> IO ()
copy Ptr Word8
dst (PS ForeignPtr Word8
fptr Int
off Int
len) = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    let beg :: Ptr b
beg = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
forall {b}. Ptr b
beg (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

foreign import ccall unsafe "string.h memcpy"
    c_memcpy
        :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
s = IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
dst Ptr Word8
src (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)