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


{-# LINE 1 "src/Codec/Compression/BZip/Pack.chs" #-}
{-# LANGUAGE TupleSections #-}

module Codec.Compression.BZip.Pack ( compress
                                   , compressWith
                                   ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Codec.Compression.BZip.Foreign.Common
import Codec.Compression.BZip.Foreign.Compress
import Codec.Compression.BZip.Common
import Control.Applicative
import Control.Monad.ST.Lazy as LazyST
import Control.Monad.ST.Lazy.Unsafe as LazyST
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Unsafe as BS
import Foreign.C.Types (CInt)
import Foreign.ForeignPtr (castForeignPtr, ForeignPtr, newForeignPtr, mallocForeignPtrBytes, withForeignPtr)
import Foreign.Ptr (Ptr, castPtr, nullPtr)



-- | @since 0.1.1.0
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = CInt -> CInt -> ByteString -> ByteString
compressWith CInt
9 CInt
30

type Step = Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> (BZAction -> IO BZError) -> IO (BZError, Maybe BS.ByteString, [BS.ByteString])

-- | See [bzlib manual](https://www.sourceware.org/bzip2/manual/manual.html#bzcompress-init)
-- for information on compression parameters.
--
-- @since 0.1.1.0
compressWith :: CInt -- ^ Block size (@1-9@)
             -> CInt -- ^ Work factor (@0-250@)
             -> BSL.ByteString
             -> BSL.ByteString
compressWith :: CInt -> CInt -> ByteString -> ByteString
compressWith CInt
blkSize CInt
wf ByteString
bsl =
    let bss :: [StrictByteString]
bss = ByteString -> [StrictByteString]
BSL.toChunks ByteString
bsl in
    [StrictByteString] -> ByteString
BSL.fromChunks ([StrictByteString] -> ByteString)
-> [StrictByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (forall s. ST s [StrictByteString]) -> [StrictByteString]
forall a. (forall s. ST s a) -> a
LazyST.runST ((forall s. ST s [StrictByteString]) -> [StrictByteString])
-> (forall s. ST s [StrictByteString]) -> [StrictByteString]
forall a b. (a -> b) -> a -> b
$ do
        (p, bufOut) <- IO (ForeignPtr BzStream, ForeignPtr (ZonkAny 0))
-> ST s (ForeignPtr BzStream, ForeignPtr (ZonkAny 0))
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (ForeignPtr BzStream, ForeignPtr (ZonkAny 0))
 -> ST s (ForeignPtr BzStream, ForeignPtr (ZonkAny 0)))
-> IO (ForeignPtr BzStream, ForeignPtr (ZonkAny 0))
-> ST s (ForeignPtr BzStream, ForeignPtr (ZonkAny 0))
forall a b. (a -> b) -> a -> b
$ do
            ptr <- IO (Ptr BzStream)
bzStreamInit
            p <- castForeignPtr <$> newForeignPtr bZ2BzCompressEnd (castPtr ptr)
            bzCompressInit blkSize wf p
            bufOut <- mallocForeignPtrBytes bufSz
            pure (p, bufOut)

        bzCompressChunks p bss bufOut

bzCompressChunks :: ForeignPtr BzStream -> [BS.ByteString] -> ForeignPtr a -> LazyST.ST s [BS.ByteString]
bzCompressChunks :: forall a s.
ForeignPtr BzStream
-> [StrictByteString] -> ForeignPtr a -> ST s [StrictByteString]
bzCompressChunks ForeignPtr BzStream
ptr' [StrictByteString]
bs ForeignPtr a
bufO = do

    ForeignPtr BzStream
-> Maybe StrictByteString
-> [StrictByteString]
-> Step
-> ForeignPtr a
-> ST s [StrictByteString]
forall a s.
ForeignPtr BzStream
-> Maybe StrictByteString
-> [StrictByteString]
-> Step
-> ForeignPtr a
-> ST s [StrictByteString]
fillBuf ForeignPtr BzStream
ptr' Maybe StrictByteString
forall a. Maybe a
Nothing [StrictByteString]
bs Step
pushBytes ForeignPtr a
bufO

    where

        -- corresponds to inner loop in zlib example
        fillBuf :: ForeignPtr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> Step -> ForeignPtr a -> LazyST.ST s [BS.ByteString]
        fillBuf :: forall a s.
ForeignPtr BzStream
-> Maybe StrictByteString
-> [StrictByteString]
-> Step
-> ForeignPtr a
-> ST s [StrictByteString]
fillBuf ForeignPtr BzStream
pForeign Maybe StrictByteString
passFwd [StrictByteString]
bs' Step
step ForeignPtr a
bufOutForeign = do
            (ret, szOut, newBSAp, bs'', keepAlive) <- IO
  (BZError, Int, [StrictByteString] -> [StrictByteString],
   [StrictByteString], Maybe StrictByteString)
-> ST
     s
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO
   (BZError, Int, [StrictByteString] -> [StrictByteString],
    [StrictByteString], Maybe StrictByteString)
 -> ST
      s
      (BZError, Int, [StrictByteString] -> [StrictByteString],
       [StrictByteString], Maybe StrictByteString))
-> IO
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
-> ST
     s
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ do
                ForeignPtr BzStream
-> (Ptr BzStream
    -> IO
         (BZError, Int, [StrictByteString] -> [StrictByteString],
          [StrictByteString], Maybe StrictByteString))
-> IO
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BzStream
pForeign ((Ptr BzStream
  -> IO
       (BZError, Int, [StrictByteString] -> [StrictByteString],
        [StrictByteString], Maybe StrictByteString))
 -> IO
      (BZError, Int, [StrictByteString] -> [StrictByteString],
       [StrictByteString], Maybe StrictByteString))
-> (Ptr BzStream
    -> IO
         (BZError, Int, [StrictByteString] -> [StrictByteString],
          [StrictByteString], Maybe StrictByteString))
-> IO
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr BzStream
p ->
                    ForeignPtr a
-> (Ptr a
    -> IO
         (BZError, Int, [StrictByteString] -> [StrictByteString],
          [StrictByteString], Maybe StrictByteString))
-> IO
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
bufOutForeign ((Ptr a
  -> IO
       (BZError, Int, [StrictByteString] -> [StrictByteString],
        [StrictByteString], Maybe StrictByteString))
 -> IO
      (BZError, Int, [StrictByteString] -> [StrictByteString],
       [StrictByteString], Maybe StrictByteString))
-> (Ptr a
    -> IO
         (BZError, Int, [StrictByteString] -> [StrictByteString],
          [StrictByteString], Maybe StrictByteString))
-> IO
     (BZError, Int, [StrictByteString] -> [StrictByteString],
      [StrictByteString], Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr a
bufOut -> do

                        let act :: BZAction -> IO BZError
act BZAction
f = do

                                (\Ptr BzStream
ptr CUInt
val -> do {Ptr BzStream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
32 (CUInt
val :: C2HSImp.CUInt)}) Ptr BzStream
p CUInt
forall a. Integral a => a
bufSz
                                (\Ptr BzStream
ptr Ptr CChar
val -> do {Ptr BzStream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
24 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr BzStream
p (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
bufOut)

                                ForeignPtr BzStream -> BZAction -> IO BZError
bZ2BzCompress ForeignPtr BzStream
ptr' BZAction
f

                        (ret, keepAlive, bs'') <- Step
step Ptr BzStream
p Maybe StrictByteString
passFwd [StrictByteString]
bs' BZAction -> IO BZError
act

                        szOut <- fromIntegral <$> (\Ptr BzStream
ptr -> do {Ptr BzStream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr BzStream
ptr Int
32 :: IO C2HSImp.CUInt}) p

                        let bytesAvail = Int
forall a. Integral a => a
bufSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
szOut

                        newBSAp <- if bytesAvail /= 0
                            then (:) <$> BS.packCStringLen (castPtr bufOut, bytesAvail)
                            else pure id

                        pure (ret, szOut, newBSAp, bs'', keepAlive)

            let step' = if Int
szOut Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Step
keepBytesAlive
                else Step
pushBytes

            if ret == BzStreamEnd
                then pure (newBSAp [])
                else newBSAp <$> fillBuf pForeign keepAlive bs'' step' bufOutForeign

        keepBytesAlive :: Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> (BZAction -> IO BZError) -> IO (BZError, Maybe BS.ByteString, [BS.ByteString])
        keepBytesAlive :: Step
keepBytesAlive Ptr BzStream
_ Maybe StrictByteString
Nothing [] BZAction -> IO BZError
act = (, Maybe StrictByteString
forall a. Maybe a
Nothing, []) (BZError -> (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO BZError
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzFinish
        keepBytesAlive Ptr BzStream
_ Maybe StrictByteString
Nothing [StrictByteString]
bs' BZAction -> IO BZError
act = (, Maybe StrictByteString
forall a. Maybe a
Nothing, [StrictByteString]
bs') (BZError -> (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO BZError
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzRun
        keepBytesAlive Ptr BzStream
_ passFwd :: Maybe StrictByteString
passFwd@(Just StrictByteString
b) [] BZAction -> IO BZError
act =
            StrictByteString
-> (CStringLen
    -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
b ((CStringLen
  -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
 -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> (CStringLen
    -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall a b. (a -> b) -> a -> b
$ \CStringLen
_ ->

                (, Maybe StrictByteString
passFwd, []) (BZError -> (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO BZError
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzFinish
        keepBytesAlive Ptr BzStream
_ passFwd :: Maybe StrictByteString
passFwd@(Just StrictByteString
b) [StrictByteString]
bs' BZAction -> IO BZError
act =
            StrictByteString
-> (CStringLen
    -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
b ((CStringLen
  -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
 -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> (CStringLen
    -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall a b. (a -> b) -> a -> b
$ \CStringLen
_ ->

                (, Maybe StrictByteString
passFwd, [StrictByteString]
bs') (BZError -> (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO BZError
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzRun

        pushBytes :: Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> (BZAction -> IO BZError) -> IO (BZError, Maybe BS.ByteString, [BS.ByteString])
        pushBytes :: Step
pushBytes Ptr BzStream
_ Maybe StrictByteString
_ [] BZAction -> IO BZError
act = (, Maybe StrictByteString
forall a. Maybe a
Nothing, []) (BZError -> (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO BZError
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzFinish
        pushBytes Ptr BzStream
p Maybe StrictByteString
_ (StrictByteString
b:[StrictByteString]
bs') BZAction -> IO BZError
act =
            StrictByteString
-> (CStringLen
    -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
b ((CStringLen
  -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
 -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> (CStringLen
    -> IO (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buf, Int
sz) -> do

                (\Ptr BzStream
ptr CUInt
val -> do {Ptr BzStream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
8 (CUInt
val :: C2HSImp.CUInt)}) Ptr BzStream
p (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
                (\Ptr BzStream
ptr Ptr CChar
val -> do {Ptr BzStream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
0 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr BzStream
p Ptr CChar
buf

                (, StrictByteString -> Maybe StrictByteString
forall a. a -> Maybe a
Just StrictByteString
b, [StrictByteString]
bs') (BZError -> (BZError, Maybe StrictByteString, [StrictByteString]))
-> IO BZError
-> IO (BZError, Maybe StrictByteString, [StrictByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzRun

bufSz :: Integral a => a
bufSz :: forall a. Integral a => a
bufSz = a
16 a -> a -> a
forall a. Num a => a -> a -> a
* a
1024

bzCompressInit :: CInt -> CInt -> ForeignPtr BzStream -> IO ()
bzCompressInit :: CInt -> CInt -> ForeignPtr BzStream -> IO ()
bzCompressInit CInt
blkSize CInt
wf ForeignPtr BzStream
ptr' = do

    ForeignPtr BzStream -> (Ptr BzStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BzStream
ptr' ((Ptr BzStream -> IO ()) -> IO ())
-> (Ptr BzStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BzStream
p -> do

        (\Ptr BzStream
ptr Ptr CChar
val -> do {Ptr BzStream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
0 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr BzStream
p Ptr CChar
forall a. Ptr a
nullPtr
        (\Ptr BzStream
ptr CUInt
val -> do {Ptr BzStream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
8 (CUInt
val :: C2HSImp.CUInt)}) Ptr BzStream
p CUInt
0

    ForeignPtr BzStream -> CInt -> CInt -> CInt -> IO ()
bZ2BzCompressInit ForeignPtr BzStream
ptr' CInt
blkSize CInt
0 CInt
wf