{-# LINE 1 "src/Codec/Lz4.chs" #-}
{-# LANGUAGE BangPatterns #-}
module Codec.Lz4 (
compressBlock
, compressBlockSingleThreaded
, decompressBlockSz
, decompressBlockSzSingleThreaded
, lZ4MaxInputSize
, compressBlockHC
, compressBlockHCSingleThreaded
, 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.Applicative
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, unsafeDupablePerformIO)
check :: LZ4FErrorCode -> IO ()
check :: LZ4FErrorCode -> IO ()
check 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 (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1014)
decompressBufSz :: Int
-> BSL.ByteString
-> BSL.ByteString
decompressBufSz :: Int -> ByteString -> ByteString
decompressBufSz Int
bufSz 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
(ForeignPtr LzDecompressionCtx
ctx, 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
(LZ4FErrorCode
err, 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 ()
lZ4FFreeDecompressionContext (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 a. a -> IO a
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 :: forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
_ ForeignPtr a
_ [] = [ByteString] -> ST s [ByteString]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf (ByteString
b:[ByteString]
bs') = do
(Maybe ByteString
nxt, 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
Maybe ByteString
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 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 :: forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
stepChunk !ForeignPtr LzDecompressionCtx
ctx !ForeignPtr a
dst 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
$ \(Ptr CChar
buf, 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
$ \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
$ \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
$ \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 a. a -> IO a
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 Int
0
compressSz :: Int
-> BSL.ByteString
-> BSL.ByteString
compressSz :: Int -> ByteString -> ByteString
compressSz Int
lvl 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
(LzCtxPtr
ctx, LzPreferencesPtr
pref, 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 a. a -> ST s a
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 :: forall s. 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
(LZ4FErrorCode
err, 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 120 "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 :: forall s.
LzCtxPtr -> LzPreferencesPtr -> [ByteString] -> ST s [ByteString]
loop LzCtxPtr
ctx LzPreferencesPtr
pref [] = ByteString -> [ByteString]
forall a. a -> [a]
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 LzCtxPtr
ctx LzPreferencesPtr
pref (ByteString
b:[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 a b. ST s (a -> b) -> ST s a -> ST s b
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 :: forall s. LzCtxPtr -> LzPreferencesPtr -> ST s ByteString
finish LzCtxPtr
ctx 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 LZ4FErrorCode
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
$ \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 :: forall s.
LzCtxPtr -> LzPreferencesPtr -> ByteString -> ST s ByteString
update !LzCtxPtr
ctx !LzPreferencesPtr
pref 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
$ \(Ptr CChar
buf, 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
$ \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
. ByteString -> IO ByteString
compressBlockIO
compressBlockSingleThreaded :: BS.ByteString -> BS.ByteString
compressBlockSingleThreaded :: ByteString -> ByteString
compressBlockSingleThreaded = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
compressBlockIO
{-# NOINLINE compressBlockSingleThreaded #-}
compressBlockIO :: BS.ByteString -> IO BS.ByteString
compressBlockIO :: ByteString -> IO ByteString
compressBlockIO = (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 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
. Int -> ByteString -> IO ByteString
compressBlockHCIO Int
lvl
compressBlockHCSingleThreaded :: Int
-> BS.ByteString
-> BS.ByteString
compressBlockHCSingleThreaded :: Int -> ByteString -> ByteString
compressBlockHCSingleThreaded Int
lvl = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> IO ByteString
compressBlockHCIO Int
lvl
{-# NOINLINE compressBlockHCSingleThreaded #-}
compressBlockHCIO :: Int -> BS.ByteString -> IO BS.ByteString
compressBlockHCIO :: Int -> ByteString -> IO ByteString
compressBlockHCIO Int
lvl = (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric (\Ptr CChar
src Ptr CChar
dst CInt
ssz 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 Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
cfun 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
$ \(Ptr CChar
buf, 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
$ \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
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Compression error"
ByteString -> IO ByteString
forall a. a -> IO a
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) Int
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 ByteString
bs Int
sz = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> IO ByteString
decompressBlockSzIO ByteString
bs Int
sz
decompressBlockSzSingleThreaded :: BS.ByteString
-> Int
-> BS.ByteString
decompressBlockSzSingleThreaded :: ByteString -> Int -> ByteString
decompressBlockSzSingleThreaded ByteString
bs Int
sz = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> IO ByteString
decompressBlockSzIO ByteString
bs Int
sz
{-# NOINLINE decompressBlockSzSingleThreaded #-}
decompressBlockSzIO :: BS.ByteString
-> Int
-> IO BS.ByteString
decompressBlockSzIO :: ByteString -> Int -> IO ByteString
decompressBlockSzIO ByteString
bs Int
expectedSz =
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
$ \(Ptr CChar
buf, Int
sz) -> do
ForeignPtr CChar
dst <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
expectedSz
CInt
bWritten <- ForeignPtr CChar -> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
dst ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \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
< CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Decompression error"
CInt -> IO CInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
bWritten
let buffer :: ByteString
buffer = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
dst) Int
0 Int
expectedSz
ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bWritten) ByteString
buffer
cint :: Enum a => a -> CInt
cint :: forall a. Enum a => 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 LzPreferencesPtr
fp 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
$ \Ptr LzPreferences
p -> do
(\Ptr LzPreferences
ptr CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
0 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (BlockSize -> CInt
forall a. Enum a => a -> CInt
cint BlockSize
Lz4fDefault)
(\Ptr LzPreferences
ptr CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
4 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (BlockMode -> CInt
forall a. Enum a => a -> CInt
cint BlockMode
Lz4fBlocklinked)
(\Ptr LzPreferences
ptr CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
8 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (ContentChecksum -> CInt
forall a. Enum a => a -> CInt
cint ContentChecksum
Lz4fNocontentchecksum)
(\Ptr LzPreferences
ptr CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
12 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (FrameType -> CInt
forall a. Enum a => a -> CInt
cint FrameType
Lz4fFrame)
(\Ptr LzPreferences
ptr CULLong
val -> do {Ptr LzPreferences -> Int -> CULLong -> IO ()
forall b. Ptr b -> Int -> CULLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
16 (CULLong
val :: C2HSImp.CULLong)}) Ptr LzPreferences
p CULLong
0
(\Ptr LzPreferences
ptr CUInt
val -> do {Ptr LzPreferences -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
24 (CUInt
val :: C2HSImp.CUInt)}) Ptr LzPreferences
p CUInt
0
(\Ptr LzPreferences
ptr CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
28 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (BlockChecksum -> CInt
forall a. Enum a => a -> CInt
cint BlockChecksum
Lz4fNoblockchecksum)
(\Ptr LzPreferences
ptr CInt
val -> do {Ptr LzPreferences -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
32 (CInt
val :: C2HSImp.CInt)}) Ptr LzPreferences
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
(\Ptr LzPreferences
ptr CUInt
val -> do {Ptr LzPreferences -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
36 (CUInt
val :: C2HSImp.CUInt)}) Ptr LzPreferences
p CUInt
0
(\Ptr LzPreferences
ptr CUInt
val -> do {Ptr LzPreferences -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr LzPreferences
ptr Int
40 (CUInt
val :: C2HSImp.CUInt)}) Ptr LzPreferences
p CUInt
0