{-# LINE 1 "src/Codec/Lz4.chs" #-}
{-# LANGUAGE BangPatterns #-}
module Codec.Lz4 (
compressBlock
, decompressBlockSz
, lZ4MaxInputSize
, compressBlockHC
, lZ4HCClevelMax
, compress
, compressSz
, decompress
, decompressBufSz
, lZ4VersionNumber
, lZ4VersionString
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Storable as C2HSImp
import Codec.Lz4.Foreign
import Control.Monad (when)
import Control.Monad.ST.Lazy (runST)
import qualified Control.Monad.ST.Lazy as LazyST
import qualified Control.Monad.ST.Lazy.Unsafe as LazyST
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Unsafe as BS
import Foreign.C.String (CString)
import Foreign.C.Types (CInt)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.ForeignPtr (ForeignPtr, castForeignPtr,
mallocForeignPtrBytes,
newForeignPtr, withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable (peek, poke)
import System.IO.Unsafe (unsafePerformIO)
check :: LZ4FErrorCode -> IO ()
check :: LZ4FErrorCode -> IO ()
check err :: LZ4FErrorCode
err = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LZ4FErrorCode -> Bool
lZ4FIsError LZ4FErrorCode
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error (LZ4FErrorCode -> [Char]
lZ4FGetErrorName LZ4FErrorCode
err)
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress = Int -> ByteString -> ByteString
decompressBufSz (64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1014)
decompressBufSz :: Int
-> BSL.ByteString
-> BSL.ByteString
decompressBufSz :: Int -> ByteString -> ByteString
decompressBufSz bufSz :: Int
bufSz bs :: ByteString
bs = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do
let bss :: [ByteString]
bss = ByteString -> [ByteString]
BSL.toChunks ByteString
bs
(ctx :: ForeignPtr LzDecompressionCtx
ctx, buf :: ForeignPtr Any
buf) <- IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> ST s (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> ST s (ForeignPtr LzDecompressionCtx, ForeignPtr Any))
-> IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> ST s (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
forall a b. (a -> b) -> a -> b
$ do
(err :: LZ4FErrorCode
err, preCtx :: Ptr LzDecompressionCtx
preCtx) <- CUInt -> IO (LZ4FErrorCode, Ptr LzDecompressionCtx)
lZ4FCreateDecompressionContext CUInt
lZ4FGetVersion
ForeignPtr LzDecompressionCtx
ctx <- ForeignPtr () -> ForeignPtr LzDecompressionCtx
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr LzDecompressionCtx)
-> IO (ForeignPtr ()) -> IO (ForeignPtr LzDecompressionCtx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
lZ4FFreeCompressionContext (Ptr LzDecompressionCtx -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr LzDecompressionCtx
preCtx)
LZ4FErrorCode -> IO ()
check LZ4FErrorCode
err
ForeignPtr Any
dstBuf <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
bufSz
(ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr LzDecompressionCtx
ctx, ForeignPtr Any
dstBuf)
[ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> ST s [ByteString] -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr LzDecompressionCtx
-> ForeignPtr Any -> [ByteString] -> ST s [ByteString]
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr Any
buf [ByteString]
bss
where loop :: LzDecompressionCtxPtr -> ForeignPtr a -> [BS.ByteString] -> LazyST.ST s [BS.ByteString]
loop :: ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop _ _ [] = [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
loop ctx :: ForeignPtr LzDecompressionCtx
ctx buf :: ForeignPtr a
buf (b :: ByteString
b:bs' :: [ByteString]
bs') = do
(nxt :: Maybe ByteString
nxt, res :: ByteString
res) <- ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
stepChunk ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf ByteString
b
case Maybe ByteString
nxt of
Nothing -> (ByteString
resByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf [ByteString]
bs'
Just next :: ByteString
next -> (ByteString
resByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf (ByteString
nextByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bs')
stepChunk :: LzDecompressionCtxPtr -> ForeignPtr a -> BS.ByteString -> LazyST.ST s (Maybe BS.ByteString, BS.ByteString)
stepChunk :: ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
stepChunk !ForeignPtr LzDecompressionCtx
ctx !ForeignPtr a
dst b :: ByteString
b = IO (Maybe ByteString, ByteString)
-> ST s (Maybe ByteString, ByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (Maybe ByteString, ByteString)
-> ST s (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
-> ST s (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
ByteString
-> (CStringLen -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString))
-> (CStringLen -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) ->
ForeignPtr a
-> (Ptr a -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
dst ((Ptr a -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString))
-> (Ptr a -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \d :: Ptr a
d ->
(Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString))
-> (Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \dSzPtr :: Ptr LZ4FErrorCode
dSzPtr ->
(Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString))
-> (Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \szPtr :: Ptr LZ4FErrorCode
szPtr -> do
Ptr LZ4FErrorCode -> LZ4FErrorCode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr LZ4FErrorCode
dSzPtr (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSz)
Ptr LZ4FErrorCode -> LZ4FErrorCode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr LZ4FErrorCode
szPtr (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
LZ4FErrorCode
res <- ForeignPtr LzDecompressionCtx
-> Ptr a
-> Ptr LZ4FErrorCode
-> Ptr CChar
-> Ptr LZ4FErrorCode
-> LzDecompressOptionsPtr
-> IO LZ4FErrorCode
forall a b.
ForeignPtr LzDecompressionCtx
-> Ptr a
-> Ptr LZ4FErrorCode
-> Ptr b
-> Ptr LZ4FErrorCode
-> LzDecompressOptionsPtr
-> IO LZ4FErrorCode
lZ4FDecompress ForeignPtr LzDecompressionCtx
ctx Ptr a
d Ptr LZ4FErrorCode
dSzPtr Ptr CChar
buf Ptr LZ4FErrorCode
szPtr LzDecompressOptionsPtr
forall a. Ptr a
nullPtr
LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
LZ4FErrorCode
bRead <- Ptr LZ4FErrorCode -> IO LZ4FErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr LZ4FErrorCode
szPtr
LZ4FErrorCode
bWritten <- Ptr LZ4FErrorCode -> IO LZ4FErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr LZ4FErrorCode
dSzPtr
ByteString
outBs <- CStringLen -> IO ByteString
BS.packCStringLen (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
bWritten)
let remBs :: Maybe ByteString
remBs = if LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
bRead Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
then Maybe ByteString
forall a. Maybe a
Nothing
else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
BS.drop (LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
bRead) ByteString
b)
(Maybe ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
remBs, ByteString
outBs)
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = Int -> ByteString -> ByteString
compressSz 0
compressSz :: Int
-> BSL.ByteString
-> BSL.ByteString
compressSz :: Int -> ByteString -> ByteString
compressSz lvl :: Int
lvl bs :: ByteString
bs = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do
let bss :: [ByteString]
bss = ByteString -> [ByteString]
BSL.toChunks ByteString
bs
(ctx :: LzCtxPtr
ctx, pref :: LzPreferencesPtr
pref, header :: ByteString
header) <- ST s (LzCtxPtr, LzPreferencesPtr, ByteString)
forall s. ST s (LzCtxPtr, LzPreferencesPtr, ByteString)
initCtx
[ByteString]
rest <- LzCtxPtr -> LzPreferencesPtr -> [ByteString] -> ST s [ByteString]
forall s.
LzCtxPtr -> LzPreferencesPtr -> [ByteString] -> ST s [ByteString]
loop LzCtxPtr
ctx LzPreferencesPtr
pref [ByteString]
bss
ByteString -> ST s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ST s ByteString) -> ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BSL.fromChunks (ByteString
headerByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
rest)
where initCtx :: LazyST.ST s (LzCtxPtr, LzPreferencesPtr, BS.ByteString)
initCtx :: ST s (LzCtxPtr, LzPreferencesPtr, ByteString)
initCtx = IO (LzCtxPtr, LzPreferencesPtr, ByteString)
-> ST s (LzCtxPtr, LzPreferencesPtr, ByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (LzCtxPtr, LzPreferencesPtr, ByteString)
-> ST s (LzCtxPtr, LzPreferencesPtr, ByteString))
-> IO (LzCtxPtr, LzPreferencesPtr, ByteString)
-> ST s (LzCtxPtr, LzPreferencesPtr, ByteString)
forall a b. (a -> b) -> a -> b
$ do
(err :: LZ4FErrorCode
err, preCtx :: Ptr LzCtx
preCtx) <- CUInt -> IO (LZ4FErrorCode, Ptr LzCtx)
lZ4FCreateCompressionContext CUInt
lZ4FGetVersion
LzCtxPtr
ctx <- castForeignPtr (ForeignPtr () -> LzCtxPtr) -> IO (ForeignPtr ()) -> IO LzCtxPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
lZ4FFreeCompressionContext (Ptr LzCtx -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr LzCtx
preCtx)
LZ4FErrorCode -> IO ()
check LZ4FErrorCode
err
dst <- mallocForeignPtrBytes lZ4FHeaderSizeMax
pref <- mallocForeignPtrBytes 56
{-# LINE 117 "src/Codec/Lz4.chs" #-}
preferencesPtr pref lvl
header <- withForeignPtr dst $ \d -> do
res <- lZ4FCompressBegin ctx d lZ4FHeaderSizeMax pref
check res
BS.packCStringLen (castPtr d, fromIntegral res)
pure (ctx, pref, header)
loop :: LzCtxPtr -> LzPreferencesPtr -> [BS.ByteString] -> LazyST.ST s [BS.ByteString]
loop :: LzCtxPtr -> LzPreferencesPtr -> [ByteString] -> ST s [ByteString]
loop ctx :: LzCtxPtr
ctx pref :: LzPreferencesPtr
pref [] = ByteString -> [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [ByteString])
-> ST s ByteString -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LzCtxPtr -> LzPreferencesPtr -> ST s ByteString
forall s. LzCtxPtr -> LzPreferencesPtr -> ST s ByteString
finish LzCtxPtr
ctx LzPreferencesPtr
pref
loop ctx :: LzCtxPtr
ctx pref :: LzPreferencesPtr
pref (b :: ByteString
b:bs' :: [ByteString]
bs') = (:) (ByteString -> [ByteString] -> [ByteString])
-> ST s ByteString -> ST s ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LzCtxPtr -> LzPreferencesPtr -> ByteString -> ST s ByteString
forall s.
LzCtxPtr -> LzPreferencesPtr -> ByteString -> ST s ByteString
update LzCtxPtr
ctx LzPreferencesPtr
pref ByteString
b ST s ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LzCtxPtr -> LzPreferencesPtr -> [ByteString] -> ST s [ByteString]
forall s.
LzCtxPtr -> LzPreferencesPtr -> [ByteString] -> ST s [ByteString]
loop LzCtxPtr
ctx LzPreferencesPtr
pref [ByteString]
bs'
finish :: LzCtxPtr -> LzPreferencesPtr -> LazyST.ST s BS.ByteString
finish :: LzCtxPtr -> LzPreferencesPtr -> ST s ByteString
finish ctx :: LzCtxPtr
ctx pref :: LzPreferencesPtr
pref = IO ByteString -> ST s ByteString
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO ByteString -> ST s ByteString)
-> IO ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ do
let expectedSz :: LZ4FErrorCode
expectedSz = LZ4FErrorCode -> LzPreferencesPtr -> LZ4FErrorCode
lZ4FCompressBound 0 LzPreferencesPtr
pref
ForeignPtr Any
dst <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
expectedSz)
ForeignPtr Any -> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Any
dst ((Ptr Any -> IO ByteString) -> IO ByteString)
-> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr Any
d -> do
LZ4FErrorCode
res <- LzCtxPtr
-> Ptr Any
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
forall a.
LzCtxPtr
-> Ptr a
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
lZ4FCompressEnd LzCtxPtr
ctx Ptr Any
d LZ4FErrorCode
expectedSz LzCompressOptionsPtr
forall a. Ptr a
nullPtr
LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
res)
update :: LzCtxPtr -> LzPreferencesPtr -> BS.ByteString -> LazyST.ST s BS.ByteString
update :: LzCtxPtr -> LzPreferencesPtr -> ByteString -> ST s ByteString
update !LzCtxPtr
ctx !LzPreferencesPtr
pref b :: ByteString
b = IO ByteString -> ST s ByteString
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO ByteString -> ST s ByteString)
-> IO ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) -> do
let expectedSz :: LZ4FErrorCode
expectedSz = LZ4FErrorCode -> LzPreferencesPtr -> LZ4FErrorCode
lZ4FCompressBound (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) LzPreferencesPtr
pref
ForeignPtr Any
dst <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
expectedSz)
ForeignPtr Any -> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Any
dst ((Ptr Any -> IO ByteString) -> IO ByteString)
-> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr Any
d -> do
LZ4FErrorCode
res <- LzCtxPtr
-> Ptr Any
-> LZ4FErrorCode
-> Ptr CChar
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
forall a b.
LzCtxPtr
-> Ptr a
-> LZ4FErrorCode
-> Ptr b
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
lZ4FCompressUpdate LzCtxPtr
ctx Ptr Any
d LZ4FErrorCode
expectedSz Ptr CChar
buf (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) LzCompressOptionsPtr
forall a. Ptr a
nullPtr
LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
res)
{-# NOINLINE compressBlock #-}
compressBlock :: BS.ByteString -> BS.ByteString
compressBlock :: ByteString -> ByteString
compressBlock = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
lZ4CompressDefault
{-# NOINLINE compressBlockHC #-}
compressBlockHC :: Int
-> BS.ByteString
-> BS.ByteString
compressBlockHC :: Int -> ByteString -> ByteString
compressBlockHC lvl :: Int
lvl = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric (\src :: Ptr CChar
src dst :: Ptr CChar
dst ssz :: CInt
ssz dsz :: CInt
dsz -> Ptr CChar -> Ptr CChar -> CInt -> CInt -> CInt -> IO CInt
lZ4CompressHC Ptr CChar
src Ptr CChar
dst CInt
ssz CInt
dsz (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lvl))
compressBlockGeneric :: (CString -> CString -> CInt -> CInt -> IO CInt) -> BS.ByteString -> IO BS.ByteString
compressBlockGeneric :: (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric cfun :: Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
cfun bs :: ByteString
bs =
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) -> do
let resSz :: CInt
resSz = CInt -> CInt
lZ4CompressBound (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
ForeignPtr CChar
dst <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
resSz)
ForeignPtr CChar -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
dst ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr CChar
d -> do
CInt
bWritten <- Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
cfun Ptr CChar
buf Ptr CChar
d (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) CInt
resSz
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
bWritten CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error "Compression error"
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
dst) 0 (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bWritten)
{-# NOINLINE decompressBlockSz #-}
decompressBlockSz :: BS.ByteString
-> Int
-> BS.ByteString
decompressBlockSz :: ByteString -> Int -> ByteString
decompressBlockSz bs :: ByteString
bs expectedSz :: Int
expectedSz = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) -> do
ForeignPtr CChar
dst <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
expectedSz
ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
dst ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \d :: Ptr CChar
d -> do
CInt
bWritten <- Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
lZ4DecompressSafe Ptr CChar
buf Ptr CChar
d (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
expectedSz)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
bWritten CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error "Decompression error"
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
dst) 0 Int
expectedSz
cint :: Enum a => a -> CInt
cint :: a -> CInt
cint = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (a -> Int) -> a -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
preferencesPtr :: LzPreferencesPtr -> Int -> IO ()
preferencesPtr :: LzPreferencesPtr -> Int -> IO ()
preferencesPtr fp :: LzPreferencesPtr
fp i :: Int
i =
LzPreferencesPtr -> (Ptr LzPreferences -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr LzPreferencesPtr
fp ((Ptr LzPreferences -> IO ()) -> IO ())
-> (Ptr LzPreferences -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \p :: Ptr LzPreferences
p -> do
(\ptr :: Ptr LzPreferences
ptr val :: CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 0 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (BlockSize -> CInt
forall a. Enum a => a -> CInt
cint BlockSize
Lz4fDefault)
(\ptr :: Ptr LzPreferences
ptr val :: CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 4 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (BlockMode -> CInt
forall a. Enum a => a -> CInt
cint BlockMode
Lz4fBlocklinked)
(\ptr :: Ptr LzPreferences
ptr val :: CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 8 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (ContentChecksum -> CInt
forall a. Enum a => a -> CInt
cint ContentChecksum
Lz4fNocontentchecksum)
(\ptr :: Ptr LzPreferences
ptr val :: CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 12 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (FrameType -> CInt
forall a. Enum a => a -> CInt
cint FrameType
Lz4fFrame)
(\ptr :: Ptr LzPreferences
ptr val :: CULLong
val -> do {Ptr LzPreferences -> Int -> CULLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 16 (CULLong
val :: C2HSImp.CULLong)}) Ptr LzPreferences
p 0
(\ptr :: Ptr LzPreferences
ptr val :: CUInt
val -> do {Ptr LzPreferences -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 24 (CUInt
val :: C2HSImp.CUInt)}) Ptr LzPreferences
p 0
(\ptr :: Ptr LzPreferences
ptr val :: CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 28 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (BlockChecksum -> CInt
forall a. Enum a => a -> CInt
cint BlockChecksum
Lz4fNoblockchecksum)
(\ptr :: Ptr LzPreferences
ptr val :: CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 32 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
(\ptr :: Ptr LzPreferences
ptr val :: CUInt
val -> do {Ptr LzPreferences -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 36 (CUInt
val :: C2HSImp.CUInt)}) Ptr LzPreferences
p 0
(\ptr :: Ptr LzPreferences
ptr val :: CUInt
val -> do {Ptr LzPreferences -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr 40 (CUInt
val :: C2HSImp.CUInt)}) Ptr LzPreferences
p 0