{-# LINE 1 "src/Codec/Compression/Lzo/Block.hsc" #-}
module Codec.Compression.Lzo.Block ( compress
, decompress
, LzoError
, lzoOk
, lzoError
, lzoOutOfMemory
, lzoNotCompressible
, lzoInputOverrun
, lzoOutputOverrun
, lzoLookbehindOverrun
, lzoEofNotFound
, lzoEInputNotConsumed
, lzoENotYetImplemented
, lzoEInvalidArgument
, lzoEInvalidAlignment
, lzoEOutputNotConsumed
, lzoEInternalError
) where
import Control.Applicative
import Control.Exception (Exception, throw)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Foreign.C.Types (CChar, CInt (..), CUInt (..))
import Control.Monad (when)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Storable (peek, poke)
import System.IO.Unsafe (unsafePerformIO)
type Byte = CChar
foreign import ccall lzo1x_1_compress :: Ptr Byte -> CUInt -> Ptr Byte -> Ptr CUInt -> Ptr a -> IO CInt
foreign import ccall lzo1x_decompress_safe :: Ptr Byte -> CUInt -> Ptr Byte -> Ptr CUInt -> Ptr a -> IO CInt
lzo1MemCompress :: Integral a => a
lzo1MemCompress = 131072
{-# LINE 40 "src/Codec/Compression/Lzo/Block.hsc" #-}
newtype LzoError = LzoError CInt deriving (Eq)
instance Exception LzoError
instance Show LzoError where
show err | err == lzoOk = "LZO_E_OK"
| err == lzoError = "LZO_E_ERROR"
| err == lzoOutOfMemory = "LZO_E_OUT_OF_MEMORY"
| err == lzoNotCompressible = "LZO_E_NOT_COMPRESSIBLE"
| err == lzoInputOverrun = "LZO_E_INPUT_OVERRUN"
| err == lzoOutputOverrun = "LZO_E_OUTPUT_OVERRUN"
| err == lzoLookbehindOverrun = "LZO_E_LOOKBEHIND_OVERRUN"
| err == lzoEofNotFound = "LZO_E_EOF_NOT_FOUND"
| err == lzoEInputNotConsumed = "LZO_E_INPUT_NOT_CONSUMED"
| err == lzoENotYetImplemented = "LZO_E_NOT_YET_IMPLEMENTED"
| err == lzoEInvalidArgument = "LZO_E_INVALID_ARGUMENT"
| err == lzoEInvalidAlignment = "LZO_E_INVALID_ALIGNMENT"
| err == lzoEOutputNotConsumed = "LZO_E_OUTPUT_NOT_CONSUMED"
| err == lzoEInternalError = "LZO_E_INTERNAL_ERROR"
| otherwise = "Invalid error code"
isError :: LzoError -> Bool
isError err | err /= lzoOk = True
| otherwise = False
lzoOk :: LzoError
lzoOk = LzoError 0
lzoError :: LzoError
lzoError = LzoError (-1)
lzoOutOfMemory :: LzoError
lzoOutOfMemory = LzoError (-2)
lzoNotCompressible :: LzoError
lzoNotCompressible = LzoError (-3)
lzoInputOverrun :: LzoError
lzoInputOverrun = LzoError (-4)
lzoOutputOverrun :: LzoError
lzoOutputOverrun = LzoError (-5)
lzoLookbehindOverrun :: LzoError
lzoLookbehindOverrun = LzoError (-6)
lzoEofNotFound :: LzoError
lzoEofNotFound = LzoError (-7)
lzoEInputNotConsumed :: LzoError
lzoEInputNotConsumed = LzoError (-8)
lzoENotYetImplemented :: LzoError
lzoENotYetImplemented = LzoError (-9)
lzoEInvalidArgument :: LzoError
lzoEInvalidArgument = LzoError (-10)
lzoEInvalidAlignment :: LzoError
lzoEInvalidAlignment = LzoError (-11)
lzoEOutputNotConsumed :: LzoError
lzoEOutputNotConsumed = LzoError (-12)
lzoEInternalError :: LzoError
lzoEInternalError = LzoError (-99)
{-# LINE 82 "src/Codec/Compression/Lzo/Block.hsc" #-}
compressBufSz :: Integral a => a -> a
compressBufSz l' = l' + (l' `div` 16) + 64 + 3
compress :: BS.ByteString -> BS.ByteString
compress inBs = unsafePerformIO $
allocaBytes lzo1MemCompress $ \memBuf ->
BS.unsafeUseAsCStringLen inBs $ \(buf, bufSz) ->
allocaBytes (compressBufSz bufSz) $ \bytePtr ->
alloca $ \szPtr -> do
res <- LzoError <$> lzo1x_1_compress buf (fromIntegral bufSz) bytePtr szPtr memBuf
when (isError res) $
throw res
sz <- peek szPtr
BS.packCStringLen (bytePtr, fromIntegral sz)
decompress :: BS.ByteString
-> Int
-> BS.ByteString
decompress inBs outSz = unsafePerformIO $
BS.unsafeUseAsCStringLen inBs $ \(buf, bufSz) ->
allocaBytes outSz $ \bytePtr ->
alloca $ \szPtr -> do
poke szPtr (fromIntegral outSz)
res <- LzoError <$> lzo1x_decompress_safe buf (fromIntegral bufSz) bytePtr szPtr nullPtr
when (isError res) $
throw res
sz <- peek szPtr
BS.packCStringLen (bytePtr, fromIntegral sz)