{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module Codec.Compression.Lzlib
(
LzEncoder
, CompressParams(..)
, compressParamPreset
, lzCompressOpen
, lzCompressClose
, lzCompressRead
, lzCompressWrite
, lzCompressSyncFlush
, lzCompressFinish
, lzCompressFinished
, lzCompressMemberFinished
, lzCompressRestartMember
, LzDecoder
, lzDecompressOpen
, lzDecompressClose
, lzDecompressRead
, lzDecompressWrite
, lzDecompressSyncToMember
, lzDecompressFinish
, lzDecompressFinished
, lzDecompressMemberFinished
, lzDecompressReset
, LzErrno(..)
) where
import Data.Bits
import qualified Data.ByteString.Internal as BS (createAndTrim)
import qualified Data.ByteString.Unsafe as BS
import Foreign
import Internal
import Prelude hiding (fromIntegral)
import Codec.Compression.Lzlib.FFI
data CompressParams = CompressParams
{ CompressParams -> Int
compressDictionarySize :: !Int
, CompressParams -> Int
compressMatchLenLimit :: !Int
, CompressParams -> Word64
compressMemberSize :: !Word64
}
compressParamPreset :: Int -> CompressParams
compressParamPreset :: Int -> CompressParams
compressParamPreset lvl :: Int
lvl = case (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
lvl) of
0 -> Int -> Int -> Word64 -> CompressParams
CompressParams 0xffff 16 Word64
msz
1 -> Int -> Int -> Word64 -> CompressParams
CompressParams (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 20) 5 Word64
msz
2 -> Int -> Int -> Word64 -> CompressParams
CompressParams (3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 19) 6 Word64
msz
3 -> Int -> Int -> Word64 -> CompressParams
CompressParams (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 21) 8 Word64
msz
4 -> Int -> Int -> Word64 -> CompressParams
CompressParams (3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 20) 12 Word64
msz
5 -> Int -> Int -> Word64 -> CompressParams
CompressParams (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 22) 20 Word64
msz
6 -> Int -> Int -> Word64 -> CompressParams
CompressParams (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 23) 36 Word64
msz
7 -> Int -> Int -> Word64 -> CompressParams
CompressParams (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 24) 68 Word64
msz
8 -> Int -> Int -> Word64 -> CompressParams
CompressParams (3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 23) 132 Word64
msz
_ -> Int -> Int -> Word64 -> CompressParams
CompressParams (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 25) 273 Word64
msz
where
msz :: Word64
msz = 0x0008000000000000
lzCompressErrno :: LzEncoder -> IO LzErrno
lzCompressErrno :: LzEncoder -> IO LzErrno
lzCompressErrno (LzEncoder fp :: ForeignPtr LzEncoder
fp) = ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO LzErrno) -> IO LzErrno
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp ((Ptr LzEncoder -> IO LzErrno) -> IO LzErrno)
-> (Ptr LzEncoder -> IO LzErrno) -> IO LzErrno
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzEncoder
encPtr -> C'LZ_Errno -> LzErrno
toLzErrno (C'LZ_Errno -> LzErrno) -> IO C'LZ_Errno -> IO LzErrno
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr LzEncoder -> IO C'LZ_Errno
c'LZ_compress_errno Ptr LzEncoder
encPtr
lzCompressOpen :: CompressParams -> IO (Either LzErrno LzEncoder)
lzCompressOpen :: CompressParams -> IO (Either LzErrno LzEncoder)
lzCompressOpen CompressParams{..} = ExceptT LzErrno IO LzEncoder -> IO (Either LzErrno LzEncoder)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT LzErrno IO LzEncoder -> IO (Either LzErrno LzEncoder))
-> ExceptT LzErrno IO LzEncoder -> IO (Either LzErrno LzEncoder)
forall a b. (a -> b) -> a -> b
$ do
Bool -> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
c'lzlib_version_check CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (ExceptT LzErrno IO () -> ExceptT LzErrno IO ())
-> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall a b. (a -> b) -> a -> b
$
LzErrno -> ExceptT LzErrno IO ()
forall (m :: * -> *) e a. Applicative m => e -> ExceptT e m a
throwE LzErrno
LzUnknown
LzEncoder
p <- ExceptT LzErrno IO LzEncoder
-> (LzEncoder -> ExceptT LzErrno IO LzEncoder)
-> Maybe LzEncoder
-> ExceptT LzErrno IO LzEncoder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LzErrno -> ExceptT LzErrno IO LzEncoder
forall (m :: * -> *) e a. Applicative m => e -> ExceptT e m a
throwE LzErrno
LzMemError) LzEncoder -> ExceptT LzErrno IO LzEncoder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LzEncoder -> ExceptT LzErrno IO LzEncoder)
-> ExceptT LzErrno IO (Maybe LzEncoder)
-> ExceptT LzErrno IO LzEncoder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe LzEncoder) -> ExceptT LzErrno IO (Maybe LzEncoder)
forall (m :: * -> *) a e. Applicative m => m a -> ExceptT e m a
liftE IO (Maybe LzEncoder)
allocEncoder
LzErrno
eno <- IO LzErrno -> ExceptT LzErrno IO LzErrno
forall (m :: * -> *) a e. Applicative m => m a -> ExceptT e m a
liftE (LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
p)
Bool -> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
== LzErrno
LzOk) (ExceptT LzErrno IO () -> ExceptT LzErrno IO ())
-> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall a b. (a -> b) -> a -> b
$ do
let (LzEncoder fp :: ForeignPtr LzEncoder
fp) = LzEncoder
p
IO () -> ExceptT LzErrno IO ()
forall (m :: * -> *) a e. Applicative m => m a -> ExceptT e m a
liftE (ForeignPtr LzEncoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzEncoder
fp)
LzErrno -> ExceptT LzErrno IO ()
forall (m :: * -> *) e a. Applicative m => e -> ExceptT e m a
throwE LzErrno
eno
LzEncoder -> ExceptT LzErrno IO LzEncoder
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzEncoder
p
where
allocEncoder :: IO (Maybe LzEncoder)
allocEncoder = IO (Maybe LzEncoder) -> IO (Maybe LzEncoder)
forall a. IO a -> IO a
mask_ (IO (Maybe LzEncoder) -> IO (Maybe LzEncoder))
-> IO (Maybe LzEncoder) -> IO (Maybe LzEncoder)
forall a b. (a -> b) -> a -> b
$ do
Ptr LzEncoder
p <- CInt -> CInt -> CULLong -> IO (Ptr LzEncoder)
c'LZ_compress_open (Int -> CInt
int2cint Int
compressDictionarySize)
(Int -> CInt
int2cint Int
compressMatchLenLimit)
(Word64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
intCast Word64
compressMemberSize)
case () of
_ | Ptr LzEncoder
p Ptr LzEncoder -> Ptr LzEncoder -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr LzEncoder
forall a. Ptr a
nullPtr -> Maybe LzEncoder -> IO (Maybe LzEncoder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LzEncoder
forall a. Maybe a
Nothing
| Bool
otherwise -> do
!ForeignPtr LzEncoder
fp <- FinalizerPtr LzEncoder
-> Ptr LzEncoder -> IO (ForeignPtr LzEncoder)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr LzEncoder
cp'LZ_compress_close Ptr LzEncoder
p
Maybe LzEncoder -> IO (Maybe LzEncoder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzEncoder -> Maybe LzEncoder
forall a. a -> Maybe a
Just (ForeignPtr LzEncoder -> LzEncoder
LzEncoder ForeignPtr LzEncoder
fp))
lzCompressClose :: LzEncoder -> IO ()
lzCompressClose :: LzEncoder -> IO ()
lzCompressClose (LzEncoder fp :: ForeignPtr LzEncoder
fp) = ForeignPtr LzEncoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzEncoder
fp
lzCompressWrite :: LzEncoder -> ByteString -> IO Int
lzCompressWrite :: LzEncoder -> ByteString -> IO Int
lzCompressWrite lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) ibs :: ByteString
ibs = do
CInt
written <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp ((Ptr LzEncoder -> IO CInt) -> IO CInt)
-> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzEncoder
encPtr -> do
ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
ibs ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(ibsptr :: Ptr CChar
ibsptr, ibslen :: Int
ibslen) -> do
Ptr LzEncoder -> Ptr Word8 -> CInt -> IO CInt
c'LZ_compress_write Ptr LzEncoder
encPtr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ibsptr) (Int -> CInt
int2cint Int
ibslen)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
written CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LzErrno -> IO ()
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO ()) -> IO LzErrno -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
intCast CInt
written)
lzCompressRead :: LzEncoder -> Int -> IO ByteString
lzCompressRead :: LzEncoder -> Int -> IO ByteString
lzCompressRead lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) bufsize0 :: Int
bufsize0
= Int -> (Ptr Word8 -> IO Int) -> IO ByteString
BS.createAndTrim (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
intCast CInt
bufsize) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \bufptr :: Ptr Word8
bufptr -> do
CInt
used <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp ((Ptr LzEncoder -> IO CInt) -> IO CInt)
-> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzEncoder
encPtr -> Ptr LzEncoder -> Ptr Word8 -> CInt -> IO CInt
c'LZ_compress_read Ptr LzEncoder
encPtr Ptr Word8
bufptr CInt
bufsize
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
used CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LzErrno -> IO ()
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO ()) -> IO LzErrno -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
intCast CInt
used)
where
bufsize :: CInt
bufsize = Int -> CInt
int2cint Int
bufsize0
lzCompressFinish :: LzEncoder -> IO LzErrno
lzCompressFinish :: LzEncoder -> IO LzErrno
lzCompressFinish lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) = do
CInt
rc <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp Ptr LzEncoder -> IO CInt
c'LZ_compress_finish
if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzErrno
LzOk
else do
LzErrno
eno <- LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzErrno -> IO LzErrno) -> LzErrno -> IO LzErrno
forall a b. (a -> b) -> a -> b
$! if LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
/= LzErrno
LzOk then LzErrno
eno else LzErrno
LzUnknown
lzCompressRestartMember :: LzEncoder -> Word64 -> IO LzErrno
lzCompressRestartMember :: LzEncoder -> Word64 -> IO LzErrno
lzCompressRestartMember lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) memberSize :: Word64
memberSize = do
CInt
rc <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp ((Ptr LzEncoder -> IO CInt) -> IO CInt)
-> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzEncoder
encPtr -> Ptr LzEncoder -> CULLong -> IO CInt
c'LZ_compress_restart_member Ptr LzEncoder
encPtr (Word64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
intCast Word64
memberSize)
if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzErrno
LzOk
else do
LzErrno
eno <- LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzErrno -> IO LzErrno) -> LzErrno -> IO LzErrno
forall a b. (a -> b) -> a -> b
$! if LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
/= LzErrno
LzOk then LzErrno
eno else LzErrno
LzUnknown
lzCompressSyncFlush :: LzEncoder -> IO LzErrno
lzCompressSyncFlush :: LzEncoder -> IO LzErrno
lzCompressSyncFlush lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) = do
CInt
rc <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp Ptr LzEncoder -> IO CInt
c'LZ_compress_sync_flush
if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzErrno
LzOk
else do
LzErrno
eno <- LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzErrno -> IO LzErrno) -> LzErrno -> IO LzErrno
forall a b. (a -> b) -> a -> b
$! if LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
/= LzErrno
LzOk then LzErrno
eno else LzErrno
LzUnknown
lzCompressFinished :: LzEncoder -> IO Bool
lzCompressFinished :: LzEncoder -> IO Bool
lzCompressFinished lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) = do
CInt
rc <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp Ptr LzEncoder -> IO CInt
c'LZ_compress_finished
case CInt
rc of
0 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
1 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
_ -> LzErrno -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO Bool) -> IO LzErrno -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
lzCompressMemberFinished :: LzEncoder -> IO Bool
lzCompressMemberFinished :: LzEncoder -> IO Bool
lzCompressMemberFinished lze :: LzEncoder
lze@(LzEncoder fp :: ForeignPtr LzEncoder
fp) = do
CInt
rc <- ForeignPtr LzEncoder -> (Ptr LzEncoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzEncoder
fp Ptr LzEncoder -> IO CInt
c'LZ_compress_member_finished
case CInt
rc of
0 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
1 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
_ -> LzErrno -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO Bool) -> IO LzErrno -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzEncoder -> IO LzErrno
lzCompressErrno LzEncoder
lze
lzDecompressErrno :: LzDecoder -> IO LzErrno
lzDecompressErrno :: LzDecoder -> IO LzErrno
lzDecompressErrno (LzDecoder fp :: ForeignPtr LzDecoder
fp) = ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO LzErrno) -> IO LzErrno
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp ((Ptr LzDecoder -> IO LzErrno) -> IO LzErrno)
-> (Ptr LzDecoder -> IO LzErrno) -> IO LzErrno
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzDecoder
encPtr -> C'LZ_Errno -> LzErrno
toLzErrno (C'LZ_Errno -> LzErrno) -> IO C'LZ_Errno -> IO LzErrno
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr LzDecoder -> IO C'LZ_Errno
c'LZ_decompress_errno Ptr LzDecoder
encPtr
lzDecompressOpen :: IO (Either LzErrno LzDecoder)
lzDecompressOpen :: IO (Either LzErrno LzDecoder)
lzDecompressOpen = ExceptT LzErrno IO LzDecoder -> IO (Either LzErrno LzDecoder)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT LzErrno IO LzDecoder -> IO (Either LzErrno LzDecoder))
-> ExceptT LzErrno IO LzDecoder -> IO (Either LzErrno LzDecoder)
forall a b. (a -> b) -> a -> b
$ do
Bool -> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
c'lzlib_version_check CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (ExceptT LzErrno IO () -> ExceptT LzErrno IO ())
-> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall a b. (a -> b) -> a -> b
$
LzErrno -> ExceptT LzErrno IO ()
forall (m :: * -> *) e a. Applicative m => e -> ExceptT e m a
throwE LzErrno
LzUnknown
LzDecoder
p <- ExceptT LzErrno IO LzDecoder
-> (LzDecoder -> ExceptT LzErrno IO LzDecoder)
-> Maybe LzDecoder
-> ExceptT LzErrno IO LzDecoder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LzErrno -> ExceptT LzErrno IO LzDecoder
forall (m :: * -> *) e a. Applicative m => e -> ExceptT e m a
throwE LzErrno
LzMemError) LzDecoder -> ExceptT LzErrno IO LzDecoder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LzDecoder -> ExceptT LzErrno IO LzDecoder)
-> ExceptT LzErrno IO (Maybe LzDecoder)
-> ExceptT LzErrno IO LzDecoder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe LzDecoder) -> ExceptT LzErrno IO (Maybe LzDecoder)
forall (m :: * -> *) a e. Applicative m => m a -> ExceptT e m a
liftE IO (Maybe LzDecoder)
allocDecoder
LzErrno
eno <- IO LzErrno -> ExceptT LzErrno IO LzErrno
forall (m :: * -> *) a e. Applicative m => m a -> ExceptT e m a
liftE (LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
p)
Bool -> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
== LzErrno
LzOk) (ExceptT LzErrno IO () -> ExceptT LzErrno IO ())
-> ExceptT LzErrno IO () -> ExceptT LzErrno IO ()
forall a b. (a -> b) -> a -> b
$ do
let (LzDecoder fp :: ForeignPtr LzDecoder
fp) = LzDecoder
p
IO () -> ExceptT LzErrno IO ()
forall (m :: * -> *) a e. Applicative m => m a -> ExceptT e m a
liftE (ForeignPtr LzDecoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzDecoder
fp)
LzErrno -> ExceptT LzErrno IO ()
forall (m :: * -> *) e a. Applicative m => e -> ExceptT e m a
throwE LzErrno
eno
LzDecoder -> ExceptT LzErrno IO LzDecoder
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzDecoder
p
where
allocDecoder :: IO (Maybe LzDecoder)
allocDecoder = IO (Maybe LzDecoder) -> IO (Maybe LzDecoder)
forall a. IO a -> IO a
mask_ (IO (Maybe LzDecoder) -> IO (Maybe LzDecoder))
-> IO (Maybe LzDecoder) -> IO (Maybe LzDecoder)
forall a b. (a -> b) -> a -> b
$ do
Ptr LzDecoder
p <- IO (Ptr LzDecoder)
c'LZ_decompress_open
case () of
_ | Ptr LzDecoder
p Ptr LzDecoder -> Ptr LzDecoder -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr LzDecoder
forall a. Ptr a
nullPtr -> Maybe LzDecoder -> IO (Maybe LzDecoder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LzDecoder
forall a. Maybe a
Nothing
| Bool
otherwise -> do
!ForeignPtr LzDecoder
fp <- FinalizerPtr LzDecoder
-> Ptr LzDecoder -> IO (ForeignPtr LzDecoder)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr LzDecoder
cp'LZ_decompress_close Ptr LzDecoder
p
Maybe LzDecoder -> IO (Maybe LzDecoder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzDecoder -> Maybe LzDecoder
forall a. a -> Maybe a
Just (ForeignPtr LzDecoder -> LzDecoder
LzDecoder ForeignPtr LzDecoder
fp))
lzDecompressClose :: LzDecoder -> IO ()
lzDecompressClose :: LzDecoder -> IO ()
lzDecompressClose (LzDecoder fp :: ForeignPtr LzDecoder
fp) = ForeignPtr LzDecoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzDecoder
fp
lzDecompressWrite :: LzDecoder -> ByteString -> IO Int
lzDecompressWrite :: LzDecoder -> ByteString -> IO Int
lzDecompressWrite lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) ibs :: ByteString
ibs = do
CInt
written <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp ((Ptr LzDecoder -> IO CInt) -> IO CInt)
-> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzDecoder
encPtr -> do
ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
ibs ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(ibsptr :: Ptr CChar
ibsptr, ibslen :: Int
ibslen) -> do
Ptr LzDecoder -> Ptr Word8 -> CInt -> IO CInt
c'LZ_decompress_write Ptr LzDecoder
encPtr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ibsptr) (Int -> CInt
int2cint Int
ibslen)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
written CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LzErrno -> IO ()
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO ()) -> IO LzErrno -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
intCast CInt
written)
lzDecompressRead :: LzDecoder -> Int -> IO ByteString
lzDecompressRead :: LzDecoder -> Int -> IO ByteString
lzDecompressRead lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) bufsize0 :: Int
bufsize0
= Int -> (Ptr Word8 -> IO Int) -> IO ByteString
BS.createAndTrim (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
intCast CInt
bufsize) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \bufptr :: Ptr Word8
bufptr -> do
CInt
used <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp ((Ptr LzDecoder -> IO CInt) -> IO CInt)
-> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzDecoder
encPtr -> Ptr LzDecoder -> Ptr Word8 -> CInt -> IO CInt
c'LZ_decompress_read Ptr LzDecoder
encPtr Ptr Word8
bufptr CInt
bufsize
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
used CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LzErrno -> IO ()
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO ()) -> IO LzErrno -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
intCast CInt
used)
where
bufsize :: CInt
bufsize = Int -> CInt
int2cint Int
bufsize0
lzDecompressSyncToMember :: LzDecoder -> IO LzErrno
lzDecompressSyncToMember :: LzDecoder -> IO LzErrno
lzDecompressSyncToMember lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) = do
CInt
rc <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp Ptr LzDecoder -> IO CInt
c'LZ_decompress_sync_to_member
if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzErrno
LzOk
else do
LzErrno
eno <- LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzErrno -> IO LzErrno) -> LzErrno -> IO LzErrno
forall a b. (a -> b) -> a -> b
$! if LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
/= LzErrno
LzOk then LzErrno
eno else LzErrno
LzUnknown
lzDecompressFinished :: LzDecoder -> IO Bool
lzDecompressFinished :: LzDecoder -> IO Bool
lzDecompressFinished lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) = do
CInt
rc <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp Ptr LzDecoder -> IO CInt
c'LZ_decompress_finished
case CInt
rc of
0 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
1 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
_ -> LzErrno -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO Bool) -> IO LzErrno -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
lzDecompressMemberFinished :: LzDecoder -> IO Bool
lzDecompressMemberFinished :: LzDecoder -> IO Bool
lzDecompressMemberFinished lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) = do
CInt
rc <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp Ptr LzDecoder -> IO CInt
c'LZ_decompress_member_finished
case CInt
rc of
0 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
1 -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
_ -> LzErrno -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (LzErrno -> IO Bool) -> IO LzErrno -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
lzDecompressFinish :: LzDecoder -> IO LzErrno
lzDecompressFinish :: LzDecoder -> IO LzErrno
lzDecompressFinish lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) = do
CInt
rc <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp Ptr LzDecoder -> IO CInt
c'LZ_decompress_finish
if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzErrno
LzOk
else do
LzErrno
eno <- LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzErrno -> IO LzErrno) -> LzErrno -> IO LzErrno
forall a b. (a -> b) -> a -> b
$! if LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
/= LzErrno
LzOk then LzErrno
eno else LzErrno
LzUnknown
lzDecompressReset :: LzDecoder -> IO LzErrno
lzDecompressReset :: LzDecoder -> IO LzErrno
lzDecompressReset lze :: LzDecoder
lze@(LzDecoder fp :: ForeignPtr LzDecoder
fp) = do
CInt
rc <- ForeignPtr LzDecoder -> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr LzDecoder
fp ((Ptr LzDecoder -> IO CInt) -> IO CInt)
-> (Ptr LzDecoder -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \encPtr :: Ptr LzDecoder
encPtr -> Ptr LzDecoder -> IO CInt
c'LZ_decompress_reset Ptr LzDecoder
encPtr
if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure LzErrno
LzOk
else do
LzErrno
eno <- LzDecoder -> IO LzErrno
lzDecompressErrno LzDecoder
lze
LzErrno -> IO LzErrno
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzErrno -> IO LzErrno) -> LzErrno -> IO LzErrno
forall a b. (a -> b) -> a -> b
$! if LzErrno
eno LzErrno -> LzErrno -> Bool
forall a. Eq a => a -> a -> Bool
/= LzErrno
LzOk then LzErrno
eno else LzErrno
LzUnknown