module Data.Repa.Convert.Format.Bytes
(VarBytes (..))
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import Data.Word
import GHC.Exts
import Prelude hiding (fail)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Internal as BS
import qualified Foreign.Marshal.Alloc as F
import qualified Foreign.ForeignPtr as F
import qualified Foreign.Storable as F
import qualified Foreign.Ptr as F
data VarBytes = VarBytes deriving (VarBytes -> VarBytes -> Bool
(VarBytes -> VarBytes -> Bool)
-> (VarBytes -> VarBytes -> Bool) -> Eq VarBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarBytes -> VarBytes -> Bool
== :: VarBytes -> VarBytes -> Bool
$c/= :: VarBytes -> VarBytes -> Bool
/= :: VarBytes -> VarBytes -> Bool
Eq, Int -> VarBytes -> ShowS
[VarBytes] -> ShowS
VarBytes -> String
(Int -> VarBytes -> ShowS)
-> (VarBytes -> String) -> ([VarBytes] -> ShowS) -> Show VarBytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarBytes -> ShowS
showsPrec :: Int -> VarBytes -> ShowS
$cshow :: VarBytes -> String
show :: VarBytes -> String
$cshowList :: [VarBytes] -> ShowS
showList :: [VarBytes] -> ShowS
Show)
instance Format VarBytes where
type Value VarBytes = ByteString
fieldCount :: VarBytes -> Int
fieldCount VarBytes
_ = Int
1
minSize :: VarBytes -> Int
minSize VarBytes
_ = Int
0
fixedSize :: VarBytes -> Maybe Int
fixedSize VarBytes
VarBytes = Maybe Int
forall a. Maybe a
Nothing
packedSize :: VarBytes -> Value VarBytes -> Maybe Int
packedSize VarBytes
VarBytes Value VarBytes
bs = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
Value VarBytes
bs
{-# INLINE fieldCount #-}
{-# INLINE minSize #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable VarBytes where
packer :: VarBytes
-> Value VarBytes -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer VarBytes
VarBytes (BS.PS ForeignPtr Word8
fptr Int
start Int
len) Addr#
dst IO ()
_fails Addr# -> IO ()
k
= ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr
((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr_
-> let
!ptr :: Ptr Any
ptr = Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Word8
ptr_ Int
start
packer_VarBytes :: Int -> IO ()
packer_VarBytes !Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
= let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
ix
in Addr# -> IO ()
k Addr#
dst'
| Bool
otherwise
= do !(Word8
x :: Word8) <- Ptr Any -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
F.peekByteOff Ptr Any
ptr Int
ix
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
F.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
ix Word8
x
Int -> IO ()
packer_VarBytes (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE packer_VarBytes #-}
in Int -> IO ()
packer_VarBytes Int
0
instance Unpackable VarBytes where
unpacker :: VarBytes
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value VarBytes -> IO ())
-> IO ()
unpacker VarBytes
VarBytes Addr#
start Addr#
end Word8 -> Bool
stop IO ()
_fail Addr# -> Value VarBytes -> IO ()
eat
= Int -> IO ()
checkLen Int
0
where
!lenBuf :: Int
lenBuf = Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
F.minusPtr (Addr# -> Ptr Word8
pw8 Addr#
end) (Addr# -> Ptr Word8
pw8 Addr#
start)
checkLen :: Int -> IO ()
checkLen !Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lenBuf
= Int -> IO ()
copy Int
lenBuf
| Bool
otherwise
= do !(Word8
x :: Word8) <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
F.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
ix
if Word8 -> Bool
stop Word8
x
then Int -> IO ()
copy Int
ix
else Int -> IO ()
checkLen (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE checkLen #-}
copy :: Int -> IO ()
copy !Int
len
= Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
F.mallocBytes Int
len IO (Ptr Word8) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr Word8
ptr
-> let
unpacker_VarBytes :: Int -> IO ()
unpacker_VarBytes !Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
= do ForeignPtr Word8
fptr <- FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
F.newForeignPtr FinalizerPtr Word8
forall a. FinalizerPtr a
F.finalizerFree Ptr Word8
ptr
let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fptr Int
0 Int
len
let !(Ptr Addr#
start') = Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len
Addr# -> Value VarBytes -> IO ()
eat Addr#
start' ByteString
Value VarBytes
bs
| Bool
otherwise
= do Word8
x :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
F.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
ix
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
F.pokeByteOff Ptr Word8
ptr Int
ix Word8
x
Int -> IO ()
unpacker_VarBytes (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in Int -> IO ()
unpacker_VarBytes Int
0
{-# INLINE copy #-}
{-# INLINE unpacker #-}
pw8 :: Addr# -> Ptr Word8
pw8 :: Addr# -> Ptr Word8
pw8 Addr#
addr = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr
{-# INLINE pw8 #-}