-- GENERATED by C->Haskell Compiler, version 0.28.6 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 :: [ByteString]
bss = ByteString -> [ByteString]
BSL.toChunks ByteString
bsl in
    [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (forall s. ST s [ByteString]) -> [ByteString]
forall a. (forall s. ST s a) -> a
LazyST.runST ((forall s. ST s [ByteString]) -> [ByteString])
-> (forall s. ST s [ByteString]) -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
        (ForeignPtr BzStream
p, ForeignPtr Any
bufOut) <- IO (ForeignPtr BzStream, ForeignPtr Any)
-> ST s (ForeignPtr BzStream, ForeignPtr Any)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (ForeignPtr BzStream, ForeignPtr Any)
 -> ST s (ForeignPtr BzStream, ForeignPtr Any))
-> IO (ForeignPtr BzStream, ForeignPtr Any)
-> ST s (ForeignPtr BzStream, ForeignPtr Any)
forall a b. (a -> b) -> a -> b
$ do
            Ptr BzStream
ptr <- IO (Ptr BzStream)
bzStreamInit
            ForeignPtr BzStream
p <- ForeignPtr () -> ForeignPtr BzStream
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr BzStream)
-> IO (ForeignPtr ()) -> IO (ForeignPtr BzStream)
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 ()
bZ2BzCompressEnd (Ptr BzStream -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr BzStream
ptr)
            CInt -> CInt -> ForeignPtr BzStream -> IO ()
bzCompressInit CInt
blkSize CInt
wf ForeignPtr BzStream
p
            ForeignPtr Any
bufOut <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
forall a. Integral a => a
bufSz
            (ForeignPtr BzStream, ForeignPtr Any)
-> IO (ForeignPtr BzStream, ForeignPtr Any)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr BzStream
p, ForeignPtr Any
bufOut)

        ForeignPtr BzStream
-> [ByteString] -> ForeignPtr Any -> ST s [ByteString]
forall a s.
ForeignPtr BzStream
-> [ByteString] -> ForeignPtr a -> ST s [ByteString]
bzCompressChunks ForeignPtr BzStream
p [ByteString]
bss ForeignPtr Any
bufOut

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

    ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
forall a s.
ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
fillBuf ForeignPtr BzStream
ptr' Maybe ByteString
forall a. Maybe a
Nothing [ByteString]
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 ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
fillBuf ForeignPtr BzStream
pForeign Maybe ByteString
passFwd [ByteString]
bs' Step
step ForeignPtr a
bufOutForeign = do
            (BZError
ret, Int
szOut, [ByteString] -> [ByteString]
newBSAp, [ByteString]
bs'', Maybe ByteString
keepAlive) <- IO
  (BZError, Int, [ByteString] -> [ByteString], [ByteString],
   Maybe ByteString)
-> ST
     s
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO
   (BZError, Int, [ByteString] -> [ByteString], [ByteString],
    Maybe ByteString)
 -> ST
      s
      (BZError, Int, [ByteString] -> [ByteString], [ByteString],
       Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
-> ST
     s
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
                ForeignPtr BzStream
-> (Ptr BzStream
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BzStream
pForeign ((Ptr BzStream
  -> IO
       (BZError, Int, [ByteString] -> [ByteString], [ByteString],
        Maybe ByteString))
 -> IO
      (BZError, Int, [ByteString] -> [ByteString], [ByteString],
       Maybe ByteString))
-> (Ptr BzStream
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr BzStream
p ->
                    ForeignPtr a
-> (Ptr a
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
bufOutForeign ((Ptr a
  -> IO
       (BZError, Int, [ByteString] -> [ByteString], [ByteString],
        Maybe ByteString))
 -> IO
      (BZError, Int, [ByteString] -> [ByteString], [ByteString],
       Maybe ByteString))
-> (Ptr a
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
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

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

                        Int
szOut <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\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}) Ptr BzStream
p

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

                        [ByteString] -> [ByteString]
newBSAp <- if Int
bytesAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                            then (:) (ByteString -> [ByteString] -> [ByteString])
-> IO ByteString -> IO ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
bufOut, Int
bytesAvail)
                            else ([ByteString] -> [ByteString]) -> IO ([ByteString] -> [ByteString])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString] -> [ByteString]
forall a. a -> a
id

                        (BZError, Int, [ByteString] -> [ByteString], [ByteString],
 Maybe ByteString)
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BZError
ret, Int
szOut, [ByteString] -> [ByteString]
newBSAp, [ByteString]
bs'', Maybe ByteString
keepAlive)

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

            if BZError
ret BZError -> BZError -> Bool
forall a. Eq a => a -> a -> Bool
== BZError
BzStreamEnd
                then [ByteString] -> ST s [ByteString]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> [ByteString]
newBSAp [])
                else [ByteString] -> [ByteString]
newBSAp ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
forall a s.
ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
fillBuf ForeignPtr BzStream
pForeign Maybe ByteString
keepAlive [ByteString]
bs'' Step
step' ForeignPtr a
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 ByteString
Nothing [] BZAction -> IO BZError
act = (, Maybe ByteString
forall a. Maybe a
Nothing, []) (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzFinish
        keepBytesAlive Ptr BzStream
_ Maybe ByteString
Nothing [ByteString]
bs' BZAction -> IO BZError
act = (, Maybe ByteString
forall a. Maybe a
Nothing, [ByteString]
bs') (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzRun
        keepBytesAlive Ptr BzStream
_ passFwd :: Maybe ByteString
passFwd@(Just ByteString
b) [] BZAction -> IO BZError
act =
            ByteString
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
 -> IO (BZError, Maybe ByteString, [ByteString]))
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a b. (a -> b) -> a -> b
$ \CStringLen
_ ->

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

                (, Maybe ByteString
passFwd, [ByteString]
bs') (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
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 ByteString
_ [] BZAction -> IO BZError
act = (, Maybe ByteString
forall a. Maybe a
Nothing, []) (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BZAction -> IO BZError
act BZAction
BzFinish
        pushBytes Ptr BzStream
p Maybe ByteString
_ (ByteString
b:[ByteString]
bs') BZAction -> IO BZError
act =
            ByteString
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
 -> IO (BZError, Maybe ByteString, [ByteString]))
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
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

                (, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b, [ByteString]
bs') (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
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