{-# language BangPatterns #-}
{-# language BlockArguments #-}
{-# language DeriveAnyClass #-}
{-# language DerivingStrategies #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language UnliftedFFITypes #-}
module Lz4.Block
(
compress
, compressU
, compressHighly
, compressHighlyU
, decompress
, decompressU
, compressInto
, requiredBufferSize
) where
import Lz4.Internal (requiredBufferSize,c_hs_compress_HC)
import Control.Monad.ST (runST)
import Control.Monad.ST.Run (runByteArrayST)
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (MutableByteArray(..),ByteArray(..))
import GHC.Exts (ByteArray#,MutableByteArray#)
import GHC.IO (unsafeIOToST)
import GHC.ST (ST(ST))
import qualified Control.Exception
import qualified Data.Primitive as PM
import qualified GHC.Exts as Exts
compressHighly ::
Int
-> Bytes
-> Bytes
compressHighly :: Int -> Bytes -> Bytes
compressHighly !Int
lvl (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) = forall a. (forall s. ST s a) -> a
runST do
let maxSz :: Int
maxSz = Int -> Int
requiredBufferSize Int
len
dst :: MutableByteArray s
dst@(MutableByteArray MutableByteArray# s
dst# ) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
maxSz
Int
actualSz <- forall a s. IO a -> ST s a
unsafeIOToST (forall s.
ByteArray#
-> Int -> MutableByteArray# s -> Int -> Int -> Int -> Int -> IO Int
c_hs_compress_HC ByteArray#
arr Int
off MutableByteArray# s
dst# Int
0 Int
len Int
maxSz Int
lvl)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m ()
PM.shrinkMutableByteArray MutableByteArray s
dst Int
actualSz
ByteArray
result <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
dst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
result Int
0 Int
actualSz)
compressHighlyU ::
Int
-> Bytes
-> ByteArray
compressHighlyU :: Int -> Bytes -> ByteArray
compressHighlyU !Int
lvl (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) = forall a. (forall s. ST s a) -> a
runST do
let maxSz :: Int
maxSz = Int -> Int
requiredBufferSize Int
len
dst :: MutableByteArray s
dst@(MutableByteArray MutableByteArray# s
dst# ) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
maxSz
Int
actualSz <- forall a s. IO a -> ST s a
unsafeIOToST (forall s.
ByteArray#
-> Int -> MutableByteArray# s -> Int -> Int -> Int -> Int -> IO Int
c_hs_compress_HC ByteArray#
arr Int
off MutableByteArray# s
dst# Int
0 Int
len Int
maxSz Int
lvl)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m ()
PM.shrinkMutableByteArray MutableByteArray s
dst Int
actualSz
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
dst
compress ::
Int
-> Bytes
-> Bytes
compress :: Int -> Bytes -> Bytes
compress !Int
lvl (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) = forall a. (forall s. ST s a) -> a
runST do
let maxSz :: Int
maxSz = Int -> Int
requiredBufferSize Int
len
dst :: MutableByteArray s
dst@(MutableByteArray MutableByteArray# s
dst# ) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
maxSz
Int
actualSz <- forall a s. IO a -> ST s a
unsafeIOToST (forall s.
ByteArray#
-> Int -> MutableByteArray# s -> Int -> Int -> Int -> Int -> IO Int
c_hs_compress_fast ByteArray#
arr Int
off MutableByteArray# s
dst# Int
0 Int
len Int
maxSz Int
lvl)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m ()
PM.shrinkMutableByteArray MutableByteArray s
dst Int
actualSz
ByteArray
result <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
dst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
result Int
0 Int
actualSz)
compressInto ::
Int
-> Bytes
-> MutableByteArray s
-> Int
-> Int
-> ST s Int
compressInto :: forall s.
Int -> Bytes -> MutableByteArray s -> Int -> Int -> ST s Int
compressInto !Int
lvl (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) dst :: MutableByteArray s
dst@(MutableByteArray MutableByteArray# s
dst# ) !Int
doff !Int
dlen = do
let maxSz :: Int
maxSz = Int -> Int
requiredBufferSize Int
len
if Int
dlen forall a. Ord a => a -> a -> Bool
< Int
maxSz
then forall a s. IO a -> ST s a
unsafeIOToST (forall e a. Exception e => e -> IO a
Control.Exception.throwIO Lz4BufferTooSmall
Lz4BufferTooSmall)
else do
Int
actualSz <- forall a s. IO a -> ST s a
unsafeIOToST (forall s.
ByteArray#
-> Int -> MutableByteArray# s -> Int -> Int -> Int -> Int -> IO Int
c_hs_compress_fast ByteArray#
arr Int
off MutableByteArray# s
dst# Int
doff Int
len Int
maxSz Int
lvl)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
doff forall a. Num a => a -> a -> a
+ Int
actualSz)
compressU ::
Int
-> Bytes
-> ByteArray
compressU :: Int -> Bytes -> ByteArray
compressU !Int
lvl (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST do
let maxSz :: Int
maxSz = Int -> Int
requiredBufferSize Int
len
dst :: MutableByteArray s
dst@(MutableByteArray MutableByteArray# s
dst# ) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
maxSz
Int
actualSz <- forall a s. IO a -> ST s a
unsafeIOToST (forall s.
ByteArray#
-> Int -> MutableByteArray# s -> Int -> Int -> Int -> Int -> IO Int
c_hs_compress_fast ByteArray#
arr Int
off MutableByteArray# s
dst# Int
0 Int
len Int
maxSz Int
lvl)
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m ()
PM.shrinkMutableByteArray MutableByteArray s
dst Int
actualSz
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
dst
decompress ::
Int
-> Bytes
-> Maybe Bytes
decompress :: Int -> Bytes -> Maybe Bytes
decompress !Int
dstSz !Bytes
b = case Int -> Bytes -> Maybe ByteArray
decompressU Int
dstSz Bytes
b of
Maybe ByteArray
Nothing -> forall a. Maybe a
Nothing
Just ByteArray
r -> forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
r Int
0 Int
dstSz)
decompressU ::
Int
-> Bytes
-> Maybe ByteArray
decompressU :: Int -> Bytes -> Maybe ByteArray
decompressU Int
dstSz (Bytes (ByteArray ByteArray#
arr) Int
off Int
len) = forall a. (forall s. ST s a) -> a
runST do
dst :: MutableByteArray s
dst@(MutableByteArray MutableByteArray# s
dst# ) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
dstSz
Int
actualSz <- forall a s. IO a -> ST s a
unsafeIOToST (forall s.
ByteArray#
-> Int -> MutableByteArray# s -> Int -> Int -> Int -> IO Int
c_hs_decompress_safe ByteArray#
arr Int
off MutableByteArray# s
dst# Int
0 Int
len Int
dstSz)
if Int
actualSz forall a. Eq a => a -> a -> Bool
== Int
dstSz
then do
ByteArray
result <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
dst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just ByteArray
result)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
foreign import ccall unsafe "hs_compress_fast"
c_hs_compress_fast ::
ByteArray#
-> Int
-> MutableByteArray# s
-> Int
-> Int
-> Int
-> Int
-> IO Int
foreign import ccall unsafe "hs_decompress_safe"
c_hs_decompress_safe ::
ByteArray#
-> Int
-> MutableByteArray# s
-> Int
-> Int
-> Int
-> IO Int
data Lz4BufferTooSmall = Lz4BufferTooSmall
deriving stock (Lz4BufferTooSmall -> Lz4BufferTooSmall -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lz4BufferTooSmall -> Lz4BufferTooSmall -> Bool
$c/= :: Lz4BufferTooSmall -> Lz4BufferTooSmall -> Bool
== :: Lz4BufferTooSmall -> Lz4BufferTooSmall -> Bool
$c== :: Lz4BufferTooSmall -> Lz4BufferTooSmall -> Bool
Eq,Int -> Lz4BufferTooSmall -> ShowS
[Lz4BufferTooSmall] -> ShowS
Lz4BufferTooSmall -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lz4BufferTooSmall] -> ShowS
$cshowList :: [Lz4BufferTooSmall] -> ShowS
show :: Lz4BufferTooSmall -> String
$cshow :: Lz4BufferTooSmall -> String
showsPrec :: Int -> Lz4BufferTooSmall -> ShowS
$cshowsPrec :: Int -> Lz4BufferTooSmall -> ShowS
Show)
deriving anyclass (Show Lz4BufferTooSmall
Typeable Lz4BufferTooSmall
SomeException -> Maybe Lz4BufferTooSmall
Lz4BufferTooSmall -> String
Lz4BufferTooSmall -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: Lz4BufferTooSmall -> String
$cdisplayException :: Lz4BufferTooSmall -> String
fromException :: SomeException -> Maybe Lz4BufferTooSmall
$cfromException :: SomeException -> Maybe Lz4BufferTooSmall
toException :: Lz4BufferTooSmall -> SomeException
$ctoException :: Lz4BufferTooSmall -> SomeException
Control.Exception.Exception)