{-# 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
, lzoVersion
, lzoVersionString
, lzoVersionDate
) where
import Control.Exception (Exception, throw)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Foreign.C.String (CString, peekCString)
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 (unsafeDupablePerformIO, unsafePerformIO)
type Byte = CChar
foreign import ccall unsafe lzo1x_1_compress :: Ptr Byte -> CUInt -> Ptr Byte -> Ptr CUInt -> Ptr a -> IO CInt
foreign import ccall unsafe lzo1x_decompress :: Ptr Byte -> CUInt -> Ptr Byte -> Ptr CUInt -> Ptr a -> IO CInt
foreign import ccall unsafe lzo_version :: CUInt
foreign import ccall unsafe lzo_version_string :: CString
foreign import ccall unsafe lzo_version_date :: CString
lzoVersion :: Word
lzoVersion = fromIntegral lzo_version
lzoVersionString :: String
lzoVersionString = unsafeDupablePerformIO $ peekCString lzo_version_string
lzoVersionDate :: String
lzoVersionDate = unsafeDupablePerformIO $ peekCString lzo_version_date
lzo1MemCompress :: Integral a => a
lzo1MemCompress = 131072
{-# LINE 59 "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 101 "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 buf (fromIntegral bufSz) bytePtr szPtr nullPtr
when (isError res) $
throw res
sz <- peek szPtr
BS.packCStringLen (bytePtr, fromIntegral sz)