{-# 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

-- | @since 0.1.1.0
lzoVersion :: Word
lzoVersion :: Word
lzoVersion = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
lzo_version

-- | @since 0.1.1.0
lzoVersionString :: String
lzoVersionString :: String
lzoVersionString = IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString CString
lzo_version_string

-- | @since 0.1.1.0
lzoVersionDate :: String
lzoVersionDate :: String
lzoVersionDate = IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString CString
lzo_version_date

lzo1MemCompress :: Integral a => a
lzo1MemCompress :: forall a. Integral a => a
lzo1MemCompress = a
131072
{-# LINE 59 "src/Codec/Compression/Lzo/Block.hsc" #-}

newtype LzoError = LzoError CInt deriving (LzoError -> LzoError -> Bool
(LzoError -> LzoError -> Bool)
-> (LzoError -> LzoError -> Bool) -> Eq LzoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LzoError -> LzoError -> Bool
$c/= :: LzoError -> LzoError -> Bool
== :: LzoError -> LzoError -> Bool
$c== :: LzoError -> LzoError -> Bool
Eq)

instance Exception LzoError

instance Show LzoError where
    show :: LzoError -> String
show LzoError
err | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoOk = String
"LZO_E_OK"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoError = String
"LZO_E_ERROR"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoOutOfMemory = String
"LZO_E_OUT_OF_MEMORY"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoNotCompressible = String
"LZO_E_NOT_COMPRESSIBLE"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoInputOverrun = String
"LZO_E_INPUT_OVERRUN"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoOutputOverrun = String
"LZO_E_OUTPUT_OVERRUN"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoLookbehindOverrun = String
"LZO_E_LOOKBEHIND_OVERRUN"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoEofNotFound = String
"LZO_E_EOF_NOT_FOUND"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoEInputNotConsumed = String
"LZO_E_INPUT_NOT_CONSUMED"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoENotYetImplemented = String
"LZO_E_NOT_YET_IMPLEMENTED"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoEInvalidArgument = String
"LZO_E_INVALID_ARGUMENT"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoEInvalidAlignment = String
"LZO_E_INVALID_ALIGNMENT"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoEOutputNotConsumed = String
"LZO_E_OUTPUT_NOT_CONSUMED"
             | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
== LzoError
lzoEInternalError = String
"LZO_E_INTERNAL_ERROR"
             | Bool
otherwise = String
"Invalid error code"

isError :: LzoError -> Bool
isError :: LzoError -> Bool
isError LzoError
err | LzoError
err LzoError -> LzoError -> Bool
forall a. Eq a => a -> a -> Bool
/= LzoError
lzoOk = Bool
True
            | Bool
otherwise = Bool
False

lzoOk  :: LzoError
lzoOk :: LzoError
lzoOk  = CInt -> LzoError
LzoError CInt
0
lzoError  :: LzoError
lzoError :: LzoError
lzoError  = CInt -> LzoError
LzoError (-CInt
1)
lzoOutOfMemory  :: LzoError
lzoOutOfMemory :: LzoError
lzoOutOfMemory  = CInt -> LzoError
LzoError (-CInt
2)
lzoNotCompressible  :: LzoError
lzoNotCompressible :: LzoError
lzoNotCompressible  = CInt -> LzoError
LzoError (-CInt
3)
lzoInputOverrun  :: LzoError
lzoInputOverrun :: LzoError
lzoInputOverrun  = CInt -> LzoError
LzoError (-CInt
4)
lzoOutputOverrun  :: LzoError
lzoOutputOverrun :: LzoError
lzoOutputOverrun  = CInt -> LzoError
LzoError (-CInt
5)
lzoLookbehindOverrun  :: LzoError
lzoLookbehindOverrun :: LzoError
lzoLookbehindOverrun  = CInt -> LzoError
LzoError (-CInt
6)
lzoEofNotFound  :: LzoError
lzoEofNotFound :: LzoError
lzoEofNotFound  = CInt -> LzoError
LzoError (-CInt
7)
lzoEInputNotConsumed  :: LzoError
lzoEInputNotConsumed :: LzoError
lzoEInputNotConsumed  = CInt -> LzoError
LzoError (-CInt
8)
lzoENotYetImplemented  :: LzoError
lzoENotYetImplemented :: LzoError
lzoENotYetImplemented  = CInt -> LzoError
LzoError (-CInt
9)
lzoEInvalidArgument  :: LzoError
lzoEInvalidArgument :: LzoError
lzoEInvalidArgument  = CInt -> LzoError
LzoError (-CInt
10)
lzoEInvalidAlignment  :: LzoError
lzoEInvalidAlignment :: LzoError
lzoEInvalidAlignment  = CInt -> LzoError
LzoError (-CInt
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

-- TODO: file format
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 -- ^ Maximum bound on output bytes
           -> BS.ByteString
decompress :: ByteString -> Int -> ByteString
decompress ByteString
inBs Int
outSz = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
inBs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
buf, Int
bufSz) ->
        Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
outSz ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
bytePtr ->
            (Ptr CUInt -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO ByteString) -> IO ByteString)
-> (Ptr CUInt -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
szPtr -> do
                Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CUInt
szPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outSz)
                LzoError
res <- CInt -> LzoError
LzoError (CInt -> LzoError) -> IO CInt -> IO LzoError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> CUInt -> CString -> Ptr CUInt -> Ptr Any -> IO CInt
forall a.
CString -> CUInt -> CString -> Ptr CUInt -> Ptr a -> IO CInt
lzo1x_decompress CString
buf (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSz) CString
bytePtr Ptr CUInt
szPtr Ptr Any
forall a. Ptr a
nullPtr
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LzoError -> Bool
isError LzoError
res) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    LzoError -> IO ()
forall a e. Exception e => e -> a
throw LzoError
res
                CUInt
sz <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
szPtr
                CStringLen -> IO ByteString
BS.packCStringLen (CString
bytePtr, CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz)