Binary.hs

{-# LANGUAGE OverloadedStrings #-}

-- https://github.com/kspalaiologos/bzip3/blob/master/doc/bzip3_format.md
module Codec.Bz3.Binary ( Chunk (..)
                        , getFileH
                        , getFrameH
                        , getChunk
                        , putFileH
                        , putChunk
                        ) where

import           Control.Monad   (unless, when)
import           Data.Binary.Get (Get, getByteString, getWord32le, getWord8,
                                  skip)
import           Data.Binary.Put (Put, putByteString, putWord32le)
import           Data.Bits       (popCount, (.&.))
import           Data.Word       (Word32)

data Chunk = Chunk { compressedSz, origSz :: !Word32 }

putFileH :: Word32 -> Put
putFileH maxSz = do
    putByteString "BZ3v1"
    putWord32le maxSz

-- max block sz
getFileH, getFrameH :: Get Word32
getFileH = do {sig <- getByteString 5; unless (sig=="BZ3v1") $ fail "bad signature"; getWord32le}

getFrameH = getFileH <* getWord32le

putChunk :: Chunk -> Put
putChunk (Chunk csz osz) = putWord32le csz *> putWord32le osz

getChunk :: Get Chunk
getChunk = do
    csz <- getWord32le; osz <- getWord32le
    if osz<64
        then getSmallBlock osz
        else getRegularBlock csz
    pure $ Chunk csz osz

getSmallBlock :: Word32 -> Get ()
getSmallBlock sz = do
    skip 4; lit <- getWord32le
    unless (lit==0xffffffff) $ fail "Small block not expected to have bwtIx"
    skip (fromIntegral sz-8)

getRegularBlock :: Word32 -> Get ()
getRegularBlock sz = do
    skip 8
    model <- getWord8
    when (model .&. 0x2 /= 0) (skip 4)
    when (model .&. 0x4 /= 0) (skip 4)
    skip (fromIntegral sz - (popCount model*4 + 9))