module Codec.Compression.SnappyC.Raw
(
compress
, decompress
) where
import Codec.Compression.SnappyC.Internal.C qualified as C
import Data.ByteString.Internal (ByteString(..))
import Foreign
import System.IO.Unsafe
import Data.ByteString.Unsafe
compress :: ByteString -> ByteString
compress :: ByteString -> ByteString
compress ByteString
bs = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
sptr, Int
slen) -> do
let dlen :: CSize
dlen = CSize -> CSize
C.snappy_max_compressed_length (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen)
Ptr CChar
dptr <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
dlen)
CSize -> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CSize
dlen ((Ptr CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
dlen_ptr ->
case
Ptr CChar -> CSize -> Ptr CChar -> Ptr CSize -> CInt
C.snappy_compress
(Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
sptr)
(Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen)
(Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
dptr)
Ptr CSize
dlen_ptr
of
CInt
0 -> do
Int
len <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dlen_ptr
CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr CChar
dptr, Int
len)
CInt
1 ->
[Char] -> IO ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: there is no invalid input for compression"
CInt
2 ->
[Char] -> IO ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: the buffer size is always set correctly"
CInt
status ->
[Char] -> IO ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$
[Char]
"impossible: unexpected status from snappy_compress: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
status
decompress :: ByteString -> Maybe ByteString
decompress :: ByteString -> Maybe ByteString
decompress ByteString
bs = IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
sptr, Int
slen) ->
(Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CSize -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
dlen_ptr ->
case
Ptr CChar -> CSize -> Ptr CSize -> CInt
C.snappy_uncompressed_length
(Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
sptr)
(Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen)
Ptr CSize
dlen_ptr
of
CInt
0 -> do
Int
dlen <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dlen_ptr
Ptr CChar
dptr <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
dlen
case
Ptr CChar -> CSize -> Ptr CChar -> Ptr CSize -> CInt
C.snappy_uncompress
(Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
sptr)
(Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen)
(Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
dptr)
Ptr CSize
dlen_ptr
of
CInt
0 -> do
Int
len <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dlen_ptr
ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr CChar
dptr, Int
len)
CInt
1 ->
Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
CInt
status ->
[Char] -> IO (Maybe ByteString)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Maybe ByteString))
-> [Char] -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
[Char]
"impossible: decompression failed with status " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
status
CInt
1 ->
Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
CInt
status ->
[Char] -> IO (Maybe ByteString)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Maybe ByteString))
-> [Char] -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
[Char]
"impossible: snappy_uncompressed_length failed with " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"status" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
status