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 ((<>))
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
extractCompressed Chunk
_ = String -> ByteString
forall a. HasCallStack => String -> a
error String
"Expected Compressed{}; possible corrupt stream"