-- | Snappy frames; see
-- [here](http://hackage.haskell.org/package/snappy-framing) for more on the
-- frame format.
module Codec.Compression.Snappy.BSL ( compress
                                    , decompress
                                    ) where

import qualified Codec.Compression.Snappy         as Snappy
import qualified Codec.Compression.Snappy.Framing as Snappy
import           Data.Binary                      (decodeOrFail, encode)
import qualified Data.ByteString.Lazy             as BSL
import           Data.Semigroup                   ((<>))

-- | Throws exception on error.
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress = [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
loop
    where loop :: ByteString -> [ByteString]
loop ByteString
bs =
            let (ByteString
res, ByteOffset
_, Chunk
chunk) = Either
  (ByteString, ByteOffset, String) (ByteString, ByteOffset, Chunk)
-> (ByteString, ByteOffset, Chunk)
forall c. Either (ByteString, ByteOffset, String) c -> c
asE (Either
   (ByteString, ByteOffset, String) (ByteString, ByteOffset, Chunk)
 -> (ByteString, ByteOffset, Chunk))
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Chunk)
-> (ByteString, ByteOffset, Chunk)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Chunk)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bs
                in if ByteString -> Bool
BSL.null ByteString
res
                    then [Chunk -> ByteString
extractUncompressed Chunk
chunk]
                    else Chunk -> ByteString
extractUncompressed Chunk
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
loop ByteString
res
          asE :: Either (ByteString, ByteOffset, String) c -> c
asE = ((ByteString, ByteOffset, String) -> c)
-> (c -> c) -> Either (ByteString, ByteOffset, String) c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> c
forall a. HasCallStack => String -> a
error(String -> c)
-> ((ByteString, ByteOffset, String) -> String)
-> (ByteString, ByteOffset, String)
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ByteString, ByteOffset, String) -> String
forall a. Show a => a -> String
show) c -> c
forall a. a -> a
id
          extractUncompressed :: Chunk -> ByteString
extractUncompressed (Snappy.Compressed Checksum
_ ByteString
d)   = ByteString -> ByteString
Snappy.decompress ByteString
d
          extractUncompressed (Snappy.Uncompressed Checksum
_ ByteString
x) = ByteString
x
          extractUncompressed Chunk
Snappy.StreamIdentifier   = ByteString
forall a. Monoid a => a
mempty
          extractUncompressed Snappy.Skippable{}        = ByteString
forall a. Monoid a => a
mempty
          extractUncompressed Chunk
_                         = String -> ByteString
forall a. HasCallStack => String -> a
error String
"Expected Uncompressed{}, Skippable{} or StreamIdentifier; possible corrupt stream"

compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = (ByteString
Snappy.streamIdentifier ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
loop
    where loop :: ByteString -> ByteString
loop ByteString
bsl =
            let (Chunk
chunk, Maybe ByteString
res) = ByteString -> (Chunk, Maybe ByteString)
Snappy.encode ByteString
bsl
                in case Maybe ByteString
res of
                    Just ByteString
x  -> Chunk -> ByteString
extractCompressed Chunk
chunk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
loop ByteString
x
                    Maybe ByteString
Nothing -> Chunk -> ByteString
extractCompressed Chunk
chunk
          extractCompressed :: Chunk -> ByteString
extractCompressed c :: Chunk
c@Snappy.Compressed{}   = Chunk -> ByteString
forall a. Binary a => a -> ByteString
encode Chunk
c
          extractCompressed c :: Chunk
c@Snappy.Uncompressed{} = Chunk -> ByteString
forall a. Binary a => a -> ByteString
encode Chunk
c
          -- see: http://hackage.haskell.org/package/snappy-framing-0.1.2/docs/Codec-Compression-Snappy-Framing.html#v:encode
          extractCompressed Chunk
_                       = String -> ByteString
forall a. HasCallStack => String -> a
error String
"Expected Compressed{}; possible corrupt stream"