{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards    #-}

-- Copyright (C) 2019  Herbert Valerio Riedel
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | Mid-level FFI bindings in the 'IO' monad to [lzlib](https://www.nongnu.org/lzip/).
--
-- See also "Codec.Compression.Lzlib.ST" for the 'ST' monad version.
module Codec.Compression.Lzlib
    ( -- * Compression functions
      LzEncoder
    , CompressParams(..)
    , compressParamPreset

    , lzCompressOpen
    , lzCompressClose
    , lzCompressRead
    , lzCompressWrite
    , lzCompressSyncFlush
    , lzCompressFinish
    , lzCompressFinished
    , lzCompressMemberFinished
    , lzCompressRestartMember

      -- * Decompression functions
    , LzDecoder

    , lzDecompressOpen
    , lzDecompressClose
    , lzDecompressRead
    , lzDecompressWrite
    , lzDecompressSyncToMember
    , lzDecompressFinish
    , lzDecompressFinished
    , lzDecompressMemberFinished
    , lzDecompressReset

      -- * Error codes
    , 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

-- | Parameters for @lzip@ compressor
--
-- If 'compressDictionarySize' is 65535 and 'compressMatchLenLimit' is 16, the \"fast variant\" of LZMA is chosen.
--
data CompressParams = CompressParams
    { CompressParams -> Int
compressDictionarySize :: !Int
      -- ^ Valid values range from 4 KiB to 512 MiB; will be rounded
      -- upwards by adding up to @('compressDictionarySize' / 8)@ to
      -- match size supported by @lzip@ format.
    , CompressParams -> Int
compressMatchLenLimit  :: !Int
      -- ^ Valid values range from 5 to 273 bytes.
    , CompressParams -> Word64
compressMemberSize     :: !Word64
      -- ^ Valid values range from 100 kB to 2 PiB.
    }

-- | Construct 'CompressParams' based on the standard preset levels used by the @lzip@ command-line interface.
--
-- The table below shows the parameters as a function of the level input argument:
--
-- +-------+--------------------------+-------------------------+
-- | level | 'compressDictionarySize' | 'compressMatchLenLimit' |
-- +=======+==========================+=========================+
-- |  ≤0   | 65535 bytes              | 16 bytes                |
-- +-------+--------------------------+-------------------------+
-- |   1   | 1 MiB                    | 5 bytes                 |
-- +-------+--------------------------+-------------------------+
-- |   2   | 1.5 MiB                  | 6 bytes                 |
-- +-------+--------------------------+-------------------------+
-- |   3   | 2 MiB                    | 8 bytes                 |
-- +-------+--------------------------+-------------------------+
-- |   4   | 3 MiB                    | 12 bytes                |
-- +-------+--------------------------+-------------------------+
-- |   5   | 4 MiB                    | 20 bytes                |
-- +-------+--------------------------+-------------------------+
-- |   6   | 8 MiB                    | 36 bytes                |
-- +-------+--------------------------+-------------------------+
-- |   7   | 16 MiB                   | 68 bytes                |
-- +-------+--------------------------+-------------------------+
-- |   8   | 24 MiB                   | 132 bytes               |
-- +-------+--------------------------+-------------------------+
-- |  ≥9   | 32 MiB                   | 273 bytes               |
-- +-------+--------------------------+-------------------------+
--
-- 'compressMemberSize' is set to its maximum allowed value (i.e. 2 PiB) for all compression levels.
--
-- __NOTE__: The \"0\" preset parameters will cause the encoder to use the \"fast variant\" of the LZMA algorithm.
--
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 -- 2 PiB

-- | Retrieve current error state of the encoder.
--
-- NOTE: This is not part of the exposed mid-level API as it must only be used right after an operation signalled failure
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

-- | Construct new 'LzEncoder'.
--
-- If a 'LzEncoder' was constructed succesfully it will be in the 'LzOk' state (as reported by 'lzCompressErrno').
--
-- __NOTE__: 'lzCompressClose' will be invoked automatically when 'LzEncoder' is garbage collected.
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
    -- critical section
    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))

-- | Promptly finalize a 'LzEncoder'.
--
-- It is not necessary to invoke 'lzCompressClose' explicitly as it
-- will be invoked implicitly when a 'LzEncoder' is garbage collected.
--
-- See also 'lzCompressOpen'.
lzCompressClose :: LzEncoder -> IO ()
lzCompressClose :: LzEncoder -> IO ()
lzCompressClose (LzEncoder fp :: ForeignPtr LzEncoder
fp) = ForeignPtr LzEncoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzEncoder
fp

-- | Push uncompressed data into the encoder. The return value is the number of bytes actually consumed.
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)

-- | Retrieve up to /n/ bytes of the compressed stream from the encoder.
--
-- Returns the empty 'ByteString' when the output buffer has been drained.
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

-- | Finalize current member.
--
-- After this operation, the output buffer has to be drained via repeated invocations of 'lzCompressRead'.
--
-- See also 'lzCompressFinished' and 'lzCompressMemberFinished'.
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

-- | Start a new member in a multimember compression stream.
--
-- Must only be called when 'lzCompressMemberFinished' is 'True'.
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

-- | Force the encoder to output the compressed stream for all the uncompressed input data.
--
-- After this operation, the output buffer has to be drained via repeated invocations of 'lzCompressRead'.
--
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


-- | Returns 'True' if the output buffer has been drained completely (which implies 'lzCompressMemberFinished').
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

-- | Returns 'True' if the output buffer has been drained completely and 'lzCompressRestartMember' can be invoked.
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







----------------------------------------------------------------------------

-- | Retrieve current error state of the decoder.
--
-- NOTE: This is not part of the exposed mid-level API as it must only be used right after an operation signalled failure
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

-- | Construct new 'LzDecoder'.
--
-- If a 'LzDecoder' was constructed succesfully it will be in the 'LzOk' state (as reported by 'lzDecompressErrno').
--
-- __NOTE__: 'lzDecompressClose' will be invoked automatically when 'LzDecoder' is garbage collected.
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
    -- critical section
    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))

-- | Promptly finalize a 'LzDecoder'.
--
-- It is not necessary to invoke 'lzDecompressClose' explicitly as it
-- will be invoked implicitly when a 'LzDecoder' is garbage collected.
--
-- See also 'lzDecompressOpen'.
lzDecompressClose :: LzDecoder -> IO ()
lzDecompressClose :: LzDecoder -> IO ()
lzDecompressClose (LzDecoder fp :: ForeignPtr LzDecoder
fp) = ForeignPtr LzDecoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr LzDecoder
fp


-- | Push compressed data into the decoder. The return value is the number of bytes actually consumed.
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)

-- | Retrieve up to /n/ bytes of the decompressed stream from the decoder.
--
-- Returns the empty 'ByteString' when the output buffer has been drained.
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


-- | Instruct decoder to discard data of current member and skip till next member.
--
-- This is a no-op if the decoder is already at the start of a member.
--
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

-- | Returns 'True' if the output buffer has been drained completely (which implies 'lzDecompressMemberFinished').
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

-- | Returns 'True' if the output buffer has been drained completely and 'lzDecompressRestartMember' can be invoked.
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

-- | Finalize current member.
--
-- After this operation, the output buffer has to be drained via repeated invocations of 'lzDecompressRead'.
--
-- See also 'lzDecompressFinished' and 'lzDecompressMemberFinished'.
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

-- | Reset 'LzEncoder' into the initial state (as if 'lzCompressOpen' had just been invoked) and discard all data.
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


----------------------------------------------------------------------------