QuickLZ.hsc

{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-- |
-- Module      : Codec.Compression.QuickLZ
-- Copyright   : (c) Austin Seipp 2011
-- License     : GPLv2
-- 
-- Maintainer  : as@hacks.yi.org
-- Stability   : experimental
-- Portability : portable
-- 
-- This module provides a high level 'ByteString' interface to
-- the QuickLZ library. More info about quicklz can be found here:
-- <http://quicklz.com>
-- 
-- QuickLZ is fast and compresses well.
-- The library that is bundled with this version is QuickLZ v1.5.0,
-- with the compression level set to 1.
-- 
-- The following laws hold:
-- 
-- @(decompress . compress) == id@
-- 
-- @(decompress xs) == (decompress xs)@
-- 
-- @(compress xs) == (compress xs)@
-- 
-- A word of notice: QuickLZ, for inputs of less than 5 bytes in length, will generate
-- different compression results for the same input on identical runs.
-- 
-- Because this behavior is not referentially transparent, we use a hack: merely short-circuit
-- on an empty input, and always pad the input with 4 extra null bytes otherwise. This yields
-- identical compression results for every input, giving compress the above nice law.
-- On decompression, after yielding the resulting string from decompression, we cut the characters off.
-- 
-- Arguably this is an abomination; nonetheless, this pure interface is a
-- nice abstraction.
-- 
module Codec.Compression.QuickLZ
( -- * Compressing and decompressing strict 'ByteString's
  compress      -- :: S.ByteString -> S.ByteString
, decompress    -- :: S.ByteString -> S.ByteString
, decompress'   -- :: S.ByteString -> S.ByteString
) where

import Foreign
import Foreign.C

import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as SI
import qualified Data.ByteString.Unsafe as U

#include <quicklz.h>

-- 
-- High-level interface
-- 

-- | Compresses the input 'ByteString'.
compress :: S.ByteString -> S.ByteString
compress xs'
  | S.null xs'    = S.empty
  | otherwise = 
      -- hack: always append 4 extra bytes to ensure input len >= 5
      let xs = xs' `S.append` (S.pack [0,0,0,0]) 
      in unsafePerformIO . allocaBytes qlz_state_compress_sz $ \compress_state ->
        SI.createAndTrim (S.length xs + 400) $ \output -> do
          U.unsafeUseAsCStringLen xs $ \(cstr,len) -> 
            c_qlz_compress cstr output len compress_state
{-# INLINEABLE compress #-}

-- | Decompress the input 'ByteString'.
decompress :: S.ByteString -> S.ByteString
decompress xs
  | S.null xs = S.empty
  | otherwise = 
      unsafePerformIO . allocaBytes qlz_state_decompress_sz $ \decompress_state -> do
        sz <- U.unsafeUseAsCString xs c_qlz_size_decompressed
        SI.createAndTrim sz $ \output -> do
          U.unsafeUseAsCString xs $ \cstr -> do 
            c_ <- c_qlz_decompress cstr output decompress_state
            return $ c_ - 4 -- hack: remove 4 ending bytes off of output string
{-# INLINEABLE decompress #-}

-- | Decompress the input 'ByteString' and save memory via overlapping decompression.
decompress' :: S.ByteString -> S.ByteString
decompress' xs
  | S.null xs = S.empty
  | otherwise = 
      unsafePerformIO . allocaBytes qlz_state_decompress_sz $ \decompress_state -> do
        d <- U.unsafeUseAsCString xs c_qlz_size_decompressed
        let sz = (d + (d `shiftR` 3) + 400)
        SI.createAndTrim sz $ \output -> do
          U.unsafeUseAsCStringLen xs $ \(cstr,clen) -> do
            let dest = output `plusPtr` (sz - clen)
            SI.memcpy dest (castPtr cstr) (fromIntegral clen)
            c_ <- c_qlz_decompress dest output decompress_state
            return $ c_ - 4 -- hack: remove 4 ending bytes off of output string

-- 
-- Simple bindings to some constants
-- 
qlz_state_compress_sz :: Int
qlz_state_compress_sz = #{size qlz_state_compress}
qlz_state_decompress_sz :: Int
qlz_state_decompress_sz = #{size qlz_state_decompress}

--
-- FFI Bindings
-- 
foreign import ccall unsafe "quicklz.h qlz_compress"
  c_qlz_compress :: Ptr a -> Ptr b -> Int -> Ptr c -> IO Int

foreign import ccall unsafe "quicklz.h qlz_decompress"
  c_qlz_decompress :: Ptr a -> Ptr b -> Ptr c -> IO Int

foreign import ccall unsafe "quicklz.h qlz_size_decompressed"
  c_qlz_size_decompressed :: CString -> IO Int