-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Codec/Lz4.chs" #-}
{-# LANGUAGE BangPatterns #-}

-- | The functions in this module throw exceptions on error.
--
-- 'decompress' and 'compress' are fully lazy, i.e. memory efficient.
module Codec.Lz4 ( -- * Functions for working with blocks
                   compressBlock
                 , decompressBlockSz
                 , lZ4MaxInputSize
                 , compressBlockHC
                 , lZ4HCClevelMax
                 -- * Functions for working with frames
                 , compress
                 , compressSz
                 , decompress
                 , decompressBufSz
                 -- * Version info
                 , 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)

-- | Lazily decompress a frame
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)

-- | @since 0.1.3.0
decompressBufSz :: Int -- ^ Size of the output buffer
                -> 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)

-- | Lazily compress a frame.
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = Int -> ByteString -> ByteString
compressSz 0

-- | @since 0.1.4.0
compressSz :: Int -- ^ Compression level
           -> 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 #-}
-- | @since 0.1.1.0
compressBlockHC :: Int -- ^ Compression level (must be less than 'lZ4HCClevelMax')
                -> 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 #-}
-- | Decompress a block. The size of the uncompressed data must be known.
decompressBlockSz :: BS.ByteString
                  -> Int -- ^ Decompressed size
                  -> 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