Foreign.chs

-- | This module uses exceptions behind the scenes
--
-- Consult the upstream [documentation](https://www.sourceware.org/bzip2/docs.html) for how to use this library.
--
-- For struct accessors, I recommend using [c2hs](http://hackage.haskell.org/package/c2hs).
module Codec.Compression.BZip.Foreign ( -- * Types
                                        BZAction (..)
                                      , BZError (..)
                                      , BzStream
                                      , BzStreamPtr
                                      , BzFile
                                      , BzFilePtr
                                      , FilePtr
                                      -- * Low-level functions
                                      , bZ2BzCompressInit
                                      , bZ2BzCompress
                                      , bZ2BzCompressEnd
                                      , bZ2BzDecompressInit
                                      , bZ2BzDecompress
                                      , bZ2BzDecompressEnd
                                      -- * High-level functions
                                      , bZ2BzReadOpen
                                      , bZ2BzReadClose
                                      , bZ2BzReadGetUnused
                                      , bZ2BzRead
                                      , bZ2BzWriteOpen
                                      , bZ2BzWrite
                                      , bZ2BzWriteClose
                                      , bZ2BzWriteClose64
                                      -- * Macros
                                      , bZMaxUnused
                                      -- * Utility functions
                                      , bZ2BzBuffToBuffCompress
                                      , bZ2BzBuffToBuffDecompress
                                      -- * Contributed functions
                                      , bZ2BzlibVersion
                                      ) where

import Control.Applicative
import Control.Exception (Exception, throw)
import Control.Monad ((<=<))
import Foreign.C.Types (CInt, CUInt)
import Foreign.Marshal (alloca)
import Foreign.Ptr (castPtr, Ptr)
import Foreign.Storable (peek)

#include <bzlib.h>

{# enum define BZAction { BZ_RUN as BzRun
                        , BZ_FLUSH as BzFlush
                        , BZ_FINISH as BzFinish
                        }
  #}

{# enum define BZError { BZ_OK as BzOk
                       , BZ_RUN_OK as BzRunOk
                       , BZ_FLUSH_OK as BzFlushOk
                       , BZ_FINISH_OK as BzFinishOk
                       , BZ_STREAM_END as BzStreamEnd
                       , BZ_SEQUENCE_ERROR as BzSequenceError
                       , BZ_PARAM_ERROR as BzParamError
                       , BZ_MEM_ERROR as BzMemError
                       , BZ_DATA_ERROR as BzDataError
                       , BZ_DATA_ERROR_MAGIC as BzDataErrorMagic
                       , BZ_IO_ERROR as BzIoError
                       , BZ_UNEXPECTED_EOF as BzUnexpectedEof
                       , BZ_OUTBUFF_FULL as BzOutbuffFull
                       , BZ_CONFIG_ERROR as BzConfigError
                       } deriving (Eq, Show)
  #}

instance Exception BZError where

-- | Abstract type
data BzStream

-- | Abstract type
data BzFile

{#pointer *bz_stream as BzStreamPtr -> BzStream #}
-- | @FILE*@ in C.
{#pointer *FILE as FilePtr newtype #}
{#pointer *BZFILE as BzFilePtr -> BzFile #}

-- Low-level functions
{# fun BZ2_bzCompressInit as ^ { `BzStreamPtr', `CInt', `CInt', `CInt' } -> `()' bzWrap*- #}
{# fun BZ2_bzCompress as ^ { `BzStreamPtr', `BZAction' } -> `BZError' bzWrap* #}
{# fun BZ2_bzCompressEnd as ^ { `BzStreamPtr' } -> `()' bzWrap*- #}
{# fun BZ2_bzDecompressInit as ^ { `BzStreamPtr', `CInt', `Bool' } -> `()' bzWrap*- #}
{# fun BZ2_bzDecompress as ^ { `BzStreamPtr' } -> `BZError' bzWrap* #}
{# fun BZ2_bzDecompressEnd as ^ { `BzStreamPtr' } -> `()' bzWrap*- #}

-- High-level functions
{# fun BZ2_bzReadOpen as ^ { alloca- `BZError' peekBZError*, `FilePtr', `CInt', `Bool', castPtr `Ptr a', `CInt' } -> `BzFilePtr' #}
{# fun BZ2_bzReadClose as ^ { alloca- `BZError' peekBZError*, `BzFilePtr' } -> `()' #}
{# fun BZ2_bzReadGetUnused as ^ { alloca- `BZError' peekBZError*, `BzFilePtr', alloca- `Ptr a' peekVoidPtr*, alloca- `CInt' peek* } -> `()' #}
{# fun BZ2_bzRead as ^ { alloca- `BZError' peekBZError*, `BzFilePtr', castPtr `Ptr a', `CInt' } -> `CInt' #}
{# fun BZ2_bzWriteOpen as ^ { alloca- `BZError' peekBZError*, `FilePtr', `CInt', `CInt', `CInt' } -> `BzFilePtr' #}
{# fun BZ2_bzWrite as ^ { alloca- `BZError' peekBZError*, `BzFilePtr', castPtr `Ptr a', `CInt' } -> `()' #}
{# fun BZ2_bzWriteClose as ^ { alloca- `BZError' peekBZError*, `BzFilePtr', `Bool', alloca- `CUInt' peek*, alloca- `CUInt' peek* } -> `()' #}
{# fun BZ2_bzWriteClose64 as ^ { alloca- `BZError' peekBZError*, `BzFilePtr', `Bool', alloca- `CUInt' peek*, alloca- `CUInt' peek*, alloca- `CUInt' peek*, alloca- `CUInt' peek* } -> `()' #}

-- Macros
bZMaxUnused :: Integral a => a
bZMaxUnused = {# const BZ_MAX_UNUSED #}

-- Utility functions
{# fun BZ2_bzBuffToBuffCompress as ^ { castPtr `Ptr a', alloca- `CUInt' peek*, castPtr `Ptr a', `CUInt', `CInt', `CInt', `CInt' } -> `()' bzWrap*- #}
{# fun BZ2_bzBuffToBuffDecompress as ^ { castPtr `Ptr a', alloca- `CUInt' peek*, castPtr `Ptr a', `CUInt', `Bool', `CInt' } -> `BZError' bzWrap* #}

-- Contributed functions
{# fun BZ2_bzlibVersion as ^ { } -> `String' #}

peekVoidPtr :: Ptr (Ptr ()) -> IO (Ptr a)
peekVoidPtr = fmap castPtr . peek

peekBZError :: Ptr CInt -> IO BZError
peekBZError = bzWrap <=< peek

bzWrap :: CInt -> IO BZError
bzWrap err =
    let err' = toEnum (fromIntegral err) in
    case err' of
        BzOk        -> pure err'
        BzRunOk     -> pure err'
        BzFlushOk   -> pure err'
        BzFinishOk  -> pure err'
        BzStreamEnd -> pure err'
        x           -> throw x