{-# LINE 1 "src/Codec/Compression/LZ4/Conduit.hsc" #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
module Codec.Compression.LZ4.Conduit
( Lz4FrameException(..)
, BlockSizeID(..)
, BlockMode(..)
, ContentChecksum(..)
, BlockChecksum(..)
, FrameType(..)
, FrameInfo(..)
, Preferences(..)
, lz4DefaultPreferences
, compress
, compressYieldImmediately
, compressWithOutBufferSize
, decompress
, bsChunksOf
, Lz4FrameCompressionContext(..)
, ScopedLz4FrameCompressionContext(..)
, ScopedLz4FramePreferencesPtr(..)
, Lz4FramePreferencesPtr(..)
, Lz4FrameDecompressionContext(..)
, lz4fCreatePreferences
, lz4fCreateCompressonContext
, lz4fCreateDecompressionContext
, withScopedLz4fPreferences
, withScopedLz4fCompressionContext
) where
import UnliftIO.Exception (throwString, bracket)
import Control.Monad (foldM, when)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (MonadResource)
import Data.Bits (testBit)
import Data.ByteString (ByteString, packCStringLen)
import Data.ByteString.Unsafe (unsafePackCString, unsafeUseAsCStringLen)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import Data.Monoid ((<>))
import Foreign.C.Types (CChar, CSize)
import Foreign.ForeignPtr (ForeignPtr, addForeignPtrFinalizer, mallocForeignPtr, mallocForeignPtrBytes, finalizeForeignPtr, withForeignPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes, malloc, free)
import Foreign.Marshal.Array (mallocArray, reallocArray)
import Foreign.Marshal.Utils (with, new)
import Foreign.Ptr (Ptr, nullPtr, FunPtr, plusPtr)
import Foreign.Storable (Storable(..), poke)
import GHC.Stack (HasCallStack)
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Context as C
import qualified Language.C.Inline.Unsafe as CUnsafe
import Text.RawString.QQ
import Codec.Compression.LZ4.CTypes (LZ4F_cctx, LZ4F_dctx, lz4FrameTypesTable, Lz4FrameException(..), BlockSizeID(..), BlockMode(..), ContentChecksum(..), BlockChecksum(..), FrameType(..), FrameInfo(..), Preferences(..))
C.context (C.baseCtx <> C.fptrCtx <> mempty { C.ctxTypesTable = lz4FrameTypesTable })
C.include "<lz4frame.h>"
C.include "<stdlib.h>"
C.include "<stdio.h>"
newtype Lz4FrameCompressionContext = Lz4FrameCompressionContext { Lz4FrameCompressionContext -> ForeignPtr (Ptr LZ4F_cctx)
unLz4FrameCompressionContext :: ForeignPtr (Ptr LZ4F_cctx) }
deriving (Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
(Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Bool)
-> Eq Lz4FrameCompressionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
== :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c/= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
/= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
Eq, Eq Lz4FrameCompressionContext
Eq Lz4FrameCompressionContext =>
(Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext)
-> (Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext)
-> Ord Lz4FrameCompressionContext
Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering
Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering
compare :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering
$c< :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
< :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c<= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
<= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c> :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
> :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c>= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
>= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$cmax :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
max :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
$cmin :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
min :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
Ord, Int -> Lz4FrameCompressionContext -> ShowS
[Lz4FrameCompressionContext] -> ShowS
Lz4FrameCompressionContext -> String
(Int -> Lz4FrameCompressionContext -> ShowS)
-> (Lz4FrameCompressionContext -> String)
-> ([Lz4FrameCompressionContext] -> ShowS)
-> Show Lz4FrameCompressionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FrameCompressionContext -> ShowS
showsPrec :: Int -> Lz4FrameCompressionContext -> ShowS
$cshow :: Lz4FrameCompressionContext -> String
show :: Lz4FrameCompressionContext -> String
$cshowList :: [Lz4FrameCompressionContext] -> ShowS
showList :: [Lz4FrameCompressionContext] -> ShowS
Show)
newtype ScopedLz4FrameCompressionContext = ScopedLz4FrameCompressionContext { ScopedLz4FrameCompressionContext -> Ptr LZ4F_cctx
unScopedLz4FrameCompressionContext :: Ptr LZ4F_cctx }
deriving (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
(ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool)
-> Eq ScopedLz4FrameCompressionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
== :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c/= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
/= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
Eq, Eq ScopedLz4FrameCompressionContext
Eq ScopedLz4FrameCompressionContext =>
(ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext)
-> (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext)
-> Ord ScopedLz4FrameCompressionContext
ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering
ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering
compare :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering
$c< :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
< :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c<= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
<= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c> :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
> :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c>= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
>= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$cmax :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
max :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
$cmin :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
min :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
Ord, Int -> ScopedLz4FrameCompressionContext -> ShowS
[ScopedLz4FrameCompressionContext] -> ShowS
ScopedLz4FrameCompressionContext -> String
(Int -> ScopedLz4FrameCompressionContext -> ShowS)
-> (ScopedLz4FrameCompressionContext -> String)
-> ([ScopedLz4FrameCompressionContext] -> ShowS)
-> Show ScopedLz4FrameCompressionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopedLz4FrameCompressionContext -> ShowS
showsPrec :: Int -> ScopedLz4FrameCompressionContext -> ShowS
$cshow :: ScopedLz4FrameCompressionContext -> String
show :: ScopedLz4FrameCompressionContext -> String
$cshowList :: [ScopedLz4FrameCompressionContext] -> ShowS
showList :: [ScopedLz4FrameCompressionContext] -> ShowS
Show)
newtype ScopedLz4FramePreferencesPtr = ScopedLz4FramePreferencesPtr { ScopedLz4FramePreferencesPtr -> Ptr Preferences
unScopedLz4FramePreferencesPtr :: Ptr Preferences }
deriving (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
(ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool)
-> Eq ScopedLz4FramePreferencesPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
== :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c/= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
/= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
Eq, Eq ScopedLz4FramePreferencesPtr
Eq ScopedLz4FramePreferencesPtr =>
(ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr)
-> (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr)
-> Ord ScopedLz4FramePreferencesPtr
ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering
ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering
compare :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering
$c< :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
< :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c<= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
<= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c> :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
> :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c>= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
>= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$cmax :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
max :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
$cmin :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
min :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
Ord, Int -> ScopedLz4FramePreferencesPtr -> ShowS
[ScopedLz4FramePreferencesPtr] -> ShowS
ScopedLz4FramePreferencesPtr -> String
(Int -> ScopedLz4FramePreferencesPtr -> ShowS)
-> (ScopedLz4FramePreferencesPtr -> String)
-> ([ScopedLz4FramePreferencesPtr] -> ShowS)
-> Show ScopedLz4FramePreferencesPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopedLz4FramePreferencesPtr -> ShowS
showsPrec :: Int -> ScopedLz4FramePreferencesPtr -> ShowS
$cshow :: ScopedLz4FramePreferencesPtr -> String
show :: ScopedLz4FramePreferencesPtr -> String
$cshowList :: [ScopedLz4FramePreferencesPtr] -> ShowS
showList :: [ScopedLz4FramePreferencesPtr] -> ShowS
Show)
newtype Lz4FramePreferencesPtr = Lz4FramePreferencesPtr { Lz4FramePreferencesPtr -> ForeignPtr Preferences
unLz4FramePreferencesPtr :: ForeignPtr Preferences }
deriving (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
(Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> Eq Lz4FramePreferencesPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
== :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c/= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
/= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
Eq, Eq Lz4FramePreferencesPtr
Eq Lz4FramePreferencesPtr =>
(Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr)
-> (Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr)
-> Ord Lz4FramePreferencesPtr
Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering
Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering
compare :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering
$c< :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
< :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c<= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
<= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c> :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
> :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c>= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
>= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$cmax :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
max :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
$cmin :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
min :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
Ord, Int -> Lz4FramePreferencesPtr -> ShowS
[Lz4FramePreferencesPtr] -> ShowS
Lz4FramePreferencesPtr -> String
(Int -> Lz4FramePreferencesPtr -> ShowS)
-> (Lz4FramePreferencesPtr -> String)
-> ([Lz4FramePreferencesPtr] -> ShowS)
-> Show Lz4FramePreferencesPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FramePreferencesPtr -> ShowS
showsPrec :: Int -> Lz4FramePreferencesPtr -> ShowS
$cshow :: Lz4FramePreferencesPtr -> String
show :: Lz4FramePreferencesPtr -> String
$cshowList :: [Lz4FramePreferencesPtr] -> ShowS
showList :: [Lz4FramePreferencesPtr] -> ShowS
Show)
newtype Lz4FrameDecompressionContext = Lz4FrameDecompressionContext { Lz4FrameDecompressionContext -> ForeignPtr (Ptr LZ4F_dctx)
unLz4FrameDecompressionContext :: ForeignPtr (Ptr LZ4F_dctx) }
deriving (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
(Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool)
-> Eq Lz4FrameDecompressionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
== :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c/= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
/= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
Eq, Eq Lz4FrameDecompressionContext
Eq Lz4FrameDecompressionContext =>
(Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext)
-> (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext)
-> Ord Lz4FrameDecompressionContext
Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering
Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering
compare :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering
$c< :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
< :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c<= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
<= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c> :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
> :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c>= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
>= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$cmax :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
max :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
$cmin :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
min :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
Ord, Int -> Lz4FrameDecompressionContext -> ShowS
[Lz4FrameDecompressionContext] -> ShowS
Lz4FrameDecompressionContext -> String
(Int -> Lz4FrameDecompressionContext -> ShowS)
-> (Lz4FrameDecompressionContext -> String)
-> ([Lz4FrameDecompressionContext] -> ShowS)
-> Show Lz4FrameDecompressionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FrameDecompressionContext -> ShowS
showsPrec :: Int -> Lz4FrameDecompressionContext -> ShowS
$cshow :: Lz4FrameDecompressionContext -> String
show :: Lz4FrameDecompressionContext -> String
$cshowList :: [Lz4FrameDecompressionContext] -> ShowS
showList :: [Lz4FrameDecompressionContext] -> ShowS
Show)
handleLz4Error :: (HasCallStack, MonadUnliftIO m) => IO CSize -> m CSize
handleLz4Error :: forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error IO CSize
f = do
CSize
ret <- IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CSize
f
Ptr CChar
staticErrMsgPtr <- IO (Ptr CChar) -> m (Ptr CChar)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO [CUnsafe.exp| const char * {
LZ4F_isError($(size_t ret))
? LZ4F_getErrorName($(size_t ret))
: NULL
} |]
if Ptr CChar
staticErrMsgPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
then CSize -> m CSize
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
ret
else do
ByteString
errMsgBs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO ByteString
unsafePackCString Ptr CChar
staticErrMsgPtr
String -> m CSize
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String
"lz4frame error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack ByteString
errMsgBs)
C.verbatim [r|
void haskell_lz4_freeCompressionContext(LZ4F_cctx** ctxPtr)
{
// We know ctxPtr can be dereferenced because it was created with
// mallocForeignPtr, so it is always pointing to something valid
// during the lifetime of the ForeignPtr (and this function is
// a finalizer function, which is called only at the very end
// inside this lifetime).
LZ4F_cctx* ctx = *ctxPtr;
// See note [Initialize LZ4 context pointer to NULL]:
// If ctx is null, we never made a successful call to
// LZ4F_createCompressionContext().
// Note at the time of writing the implementation of
// LZ4F_createCompressionContext() handles null pointers gracefully,
// but that is an undocumented implementation detail so we don't
// rely on it here.
if (ctx != NULL)
{
size_t err = LZ4F_freeCompressionContext(ctx);
if (LZ4F_isError(err))
{
fprintf(stderr, "LZ4F_freeCompressionContext failed: %s\n", LZ4F_getErrorName(err));
exit(1);
}
}
}
|]
foreign import ccall "&haskell_lz4_freeCompressionContext" haskell_lz4_freeCompressionContext :: FunPtr (Ptr (Ptr LZ4F_cctx) -> IO ())
allocateLz4fScopedCompressionContext :: IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext :: IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext = do
(Ptr (Ptr LZ4F_cctx) -> IO ScopedLz4FrameCompressionContext)
-> IO ScopedLz4FrameCompressionContext
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr LZ4F_cctx) -> IO ScopedLz4FrameCompressionContext)
-> IO ScopedLz4FrameCompressionContext)
-> (Ptr (Ptr LZ4F_cctx) -> IO ScopedLz4FrameCompressionContext)
-> IO ScopedLz4FrameCompressionContext
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr LZ4F_cctx)
ctxPtrPtr :: Ptr (Ptr LZ4F_cctx)) -> do
CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
LZ4F_cctx** ctxPtr = $(LZ4F_cctx** ctxPtrPtr);
LZ4F_errorCode_t err = LZ4F_createCompressionContext(ctxPtr, LZ4F_VERSION);
return err;
} |]
Ptr LZ4F_cctx
ctxPtr <- Ptr (Ptr LZ4F_cctx) -> IO (Ptr LZ4F_cctx)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr LZ4F_cctx)
ctxPtrPtr
ScopedLz4FrameCompressionContext
-> IO ScopedLz4FrameCompressionContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr LZ4F_cctx -> ScopedLz4FrameCompressionContext
ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctxPtr)
freeLz4ScopedCompressionContext :: ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext :: ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctxPtr) = do
CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error
[C.block| size_t {
return LZ4F_freeCompressionContext($(LZ4F_cctx* ctxPtr));
} |]
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
withScopedLz4fCompressionContext :: (HasCallStack) => (ScopedLz4FrameCompressionContext -> IO a) -> IO a
withScopedLz4fCompressionContext :: forall a.
HasCallStack =>
(ScopedLz4FrameCompressionContext -> IO a) -> IO a
withScopedLz4fCompressionContext ScopedLz4FrameCompressionContext -> IO a
f =
IO ScopedLz4FrameCompressionContext
-> (ScopedLz4FrameCompressionContext -> IO ())
-> (ScopedLz4FrameCompressionContext -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext
ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext
ScopedLz4FrameCompressionContext -> IO a
f
lz4fCreateCompressonContext :: (HasCallStack) => IO Lz4FrameCompressionContext
lz4fCreateCompressonContext :: HasCallStack => IO Lz4FrameCompressionContext
lz4fCreateCompressonContext = do
ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr :: ForeignPtr (Ptr LZ4F_cctx) <- IO (ForeignPtr (Ptr LZ4F_cctx))
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
ForeignPtr (Ptr LZ4F_cctx)
-> (Ptr (Ptr LZ4F_cctx) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr ((Ptr (Ptr LZ4F_cctx) -> IO ()) -> IO ())
-> (Ptr (Ptr LZ4F_cctx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr LZ4F_cctx)
ptr -> Ptr (Ptr LZ4F_cctx) -> Ptr LZ4F_cctx -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr LZ4F_cctx)
ptr Ptr LZ4F_cctx
forall a. Ptr a
nullPtr
FinalizerPtr (Ptr LZ4F_cctx) -> ForeignPtr (Ptr LZ4F_cctx) -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr (Ptr LZ4F_cctx)
haskell_lz4_freeCompressionContext ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr
CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
LZ4F_cctx** ctxPtr = $fptr-ptr:(LZ4F_cctx** ctxForeignPtr);
LZ4F_errorCode_t err = LZ4F_createCompressionContext(ctxPtr, LZ4F_VERSION);
return err;
} |]
Lz4FrameCompressionContext -> IO Lz4FrameCompressionContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr (Ptr LZ4F_cctx) -> Lz4FrameCompressionContext
Lz4FrameCompressionContext ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr)
lz4DefaultPreferences :: Preferences
lz4DefaultPreferences :: Preferences
lz4DefaultPreferences =
Preferences
{ frameInfo :: FrameInfo
frameInfo = FrameInfo
{ blockSizeID :: BlockSizeID
blockSizeID = BlockSizeID
LZ4F_default
, blockMode :: BlockMode
blockMode = BlockMode
LZ4F_blockLinked
, contentChecksumFlag :: ContentChecksum
contentChecksumFlag = ContentChecksum
LZ4F_noContentChecksum
, frameType :: FrameType
frameType = FrameType
LZ4F_frame
, contentSize :: Word64
contentSize = Word64
0
, dictID :: Word32
dictID = Word32
0
, blockChecksumFlag :: BlockChecksum
blockChecksumFlag = BlockChecksum
LZ4F_noBlockChecksum
}
, compressionLevel :: Int
compressionLevel = Int
0
, autoFlush :: Bool
autoFlush = Bool
False
, favorDecSpeed :: Bool
favorDecSpeed = Bool
False
}
newForeignPtr :: (Storable a) => a -> IO (ForeignPtr a)
newForeignPtr :: forall a. Storable a => a -> IO (ForeignPtr a)
newForeignPtr a
x = do
ForeignPtr a
fptr <- IO (ForeignPtr a)
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
ForeignPtr a -> IO (ForeignPtr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
fptr
lz4fCreatePreferences :: IO Lz4FramePreferencesPtr
lz4fCreatePreferences :: IO Lz4FramePreferencesPtr
lz4fCreatePreferences =
ForeignPtr Preferences -> Lz4FramePreferencesPtr
Lz4FramePreferencesPtr (ForeignPtr Preferences -> Lz4FramePreferencesPtr)
-> IO (ForeignPtr Preferences) -> IO Lz4FramePreferencesPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Preferences -> IO (ForeignPtr Preferences)
forall a. Storable a => a -> IO (ForeignPtr a)
newForeignPtr Preferences
lz4DefaultPreferences
withScopedLz4fPreferences :: (HasCallStack) => (ScopedLz4FramePreferencesPtr -> IO a) -> IO a
withScopedLz4fPreferences :: forall a.
HasCallStack =>
(ScopedLz4FramePreferencesPtr -> IO a) -> IO a
withScopedLz4fPreferences ScopedLz4FramePreferencesPtr -> IO a
f =
IO ScopedLz4FramePreferencesPtr
-> (ScopedLz4FramePreferencesPtr -> IO ())
-> (ScopedLz4FramePreferencesPtr -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(Ptr Preferences -> ScopedLz4FramePreferencesPtr
ScopedLz4FramePreferencesPtr (Ptr Preferences -> ScopedLz4FramePreferencesPtr)
-> IO (Ptr Preferences) -> IO ScopedLz4FramePreferencesPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Preferences -> IO (Ptr Preferences)
forall a. Storable a => a -> IO (Ptr a)
new Preferences
lz4DefaultPreferences)
(\(ScopedLz4FramePreferencesPtr Ptr Preferences
ptr) -> Ptr Preferences -> IO ()
forall a. Ptr a -> IO ()
free Ptr Preferences
ptr)
ScopedLz4FramePreferencesPtr -> IO a
f
lz4fCompressBegin :: (HasCallStack) => ScopedLz4FrameCompressionContext -> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin :: HasCallStack =>
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctx) (ScopedLz4FramePreferencesPtr Ptr Preferences
prefsPtr) Ptr CChar
headerBuf CSize
headerBufLen = do
CSize
headerSize <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
LZ4F_preferences_t* lz4_preferences_ptr = $(LZ4F_preferences_t* prefsPtr);
size_t err_or_headerSize = LZ4F_compressBegin($(LZ4F_cctx* ctx), $(char* headerBuf), $(size_t headerBufLen), lz4_preferences_ptr);
return err_or_headerSize;
} |]
CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
headerSize
lz4fCompressBound :: (HasCallStack) => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound :: HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
srcSize (ScopedLz4FramePreferencesPtr Ptr Preferences
prefsPtr) = do
IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
size_t err_or_frame_size = LZ4F_compressBound($(size_t srcSize), $(LZ4F_preferences_t* prefsPtr));
return err_or_frame_size;
} |]
lz4fCompressUpdate :: (HasCallStack) => ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate :: HasCallStack =>
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctx) Ptr CChar
destBuf CSize
destBufLen Ptr CChar
srcBuf CSize
srcBufLen = do
CSize
written <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
size_t err_or_written = LZ4F_compressUpdate($(LZ4F_cctx* ctx), $(char* destBuf), $(size_t destBufLen), $(char* srcBuf), $(size_t srcBufLen), NULL);
return err_or_written;
} |]
CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
written
lz4fCompressEnd :: (HasCallStack) => ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd :: HasCallStack =>
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctx) Ptr CChar
footerBuf CSize
footerBufLen = do
CSize
footerWritten <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
size_t err_or_footerWritten = LZ4F_compressEnd($(LZ4F_cctx* ctx), $(char* footerBuf), $(size_t footerBufLen), NULL);
return err_or_footerWritten;
} |]
CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
footerWritten
compress :: (MonadUnliftIO m, MonadResource m) => ConduitT ByteString ByteString m ()
compress :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
ConduitT ByteString ByteString m ()
compress = CSize -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
CSize -> ConduitT ByteString ByteString m ()
compressWithOutBufferSize CSize
0
withLz4CtxAndPrefsConduit ::
(MonadUnliftIO m, MonadResource m)
=> ((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr) -> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit :: forall (m :: * -> *) i o r.
(MonadUnliftIO m, MonadResource m) =>
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r
f = IO (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ((ScopedLz4FrameCompressionContext,
ScopedLz4FramePreferencesPtr)
-> IO ())
-> ((ScopedLz4FrameCompressionContext,
ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r)
-> ConduitT i o m r
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
(do
ScopedLz4FrameCompressionContext
ctx <- IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext
Ptr Preferences
prefPtr <- Preferences -> IO (Ptr Preferences)
forall a. Storable a => a -> IO (Ptr a)
new Preferences
lz4DefaultPreferences
(ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> IO
(ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedLz4FrameCompressionContext
ctx, Ptr Preferences -> ScopedLz4FramePreferencesPtr
ScopedLz4FramePreferencesPtr Ptr Preferences
prefPtr)
)
(\(ScopedLz4FrameCompressionContext
ctx, ScopedLz4FramePreferencesPtr Ptr Preferences
prefPtr) -> do
ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext ScopedLz4FrameCompressionContext
ctx
Ptr Preferences -> IO ()
forall a. Ptr a -> IO ()
free Ptr Preferences
prefPtr
)
(ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r
f
compressYieldImmediately :: (MonadUnliftIO m, MonadResource m) => ConduitT ByteString ByteString m ()
compressYieldImmediately :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
ConduitT ByteString ByteString m ()
compressYieldImmediately =
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
(MonadUnliftIO m, MonadResource m) =>
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit (((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ())
-> ((ScopedLz4FrameCompressionContext,
ScopedLz4FramePreferencesPtr)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(ScopedLz4FrameCompressionContext
ctx, ScopedLz4FramePreferencesPtr
prefs) -> do
let _LZ4F_HEADER_SIZE_MAX :: CSize
_LZ4F_HEADER_SIZE_MAX = CSize
19
{-# LINE 368 "src/Codec/Compression/LZ4/Conduit.hsc" #-}
ByteString
headerBs <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
_LZ4F_HEADER_SIZE_MAX) ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
headerBuf -> do
CSize
headerSize <- HasCallStack =>
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin ScopedLz4FrameCompressionContext
ctx ScopedLz4FramePreferencesPtr
prefs Ptr CChar
headerBuf CSize
_LZ4F_HEADER_SIZE_MAX
CStringLen -> IO ByteString
packCStringLen (Ptr CChar
headerBuf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
headerSize)
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
headerBs
(ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ())
-> (ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> do
Maybe ByteString
m'outBs <- IO (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe ByteString)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe ByteString))
-> IO (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bsPtr, Int
bsLen) -> do
let bsLenSize :: CSize
bsLenSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen
CSize
size <- HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
bsLenSize ScopedLz4FramePreferencesPtr
prefs
Maybe ByteString
m'outBs <- IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size) ((Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do
CSize
written <- HasCallStack =>
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate ScopedLz4FrameCompressionContext
ctx Ptr CChar
buf CSize
size Ptr CChar
bsPtr CSize
bsLenSize
if CSize
written CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
== CSize
0
then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
packCStringLen (Ptr CChar
buf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
written)
Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
m'outBs
case Maybe ByteString
m'outBs of
Maybe ByteString
Nothing -> () -> ConduitT ByteString ByteString m ()
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
outBs -> ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
outBs
CSize
footerSize <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
0 ScopedLz4FramePreferencesPtr
prefs
ByteString
footerBs <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
footerSize) ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
footerBuf -> do
CSize
footerWritten <- HasCallStack =>
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd ScopedLz4FrameCompressionContext
ctx Ptr CChar
footerBuf CSize
footerSize
CStringLen -> IO ByteString
packCStringLen (Ptr CChar
footerBuf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
footerWritten)
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
footerBs
bsChunksOf :: Int -> ByteString -> [ByteString]
bsChunksOf :: Int -> ByteString -> [ByteString]
bsChunksOf Int
chunkSize ByteString
bs
| Int
chunkSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> [ByteString]
forall a. HasCallStack => String -> a
error (String -> [ByteString]) -> String -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String
"bsChunksOf: chunkSize < 1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
chunkSize
| ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunkSize = [ByteString
bs]
| Bool
otherwise =
let (ByteString
x, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
chunkSize ByteString
bs in ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
bsChunksOf Int
chunkSize ByteString
rest
compressWithOutBufferSize :: forall m . (MonadUnliftIO m, MonadResource m) => CSize -> ConduitT ByteString ByteString m ()
compressWithOutBufferSize :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
CSize -> ConduitT ByteString ByteString m ()
compressWithOutBufferSize CSize
bufferSize =
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
(MonadUnliftIO m, MonadResource m) =>
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit (((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ())
-> ((ScopedLz4FrameCompressionContext,
ScopedLz4FramePreferencesPtr)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(ScopedLz4FrameCompressionContext
ctx, ScopedLz4FramePreferencesPtr
prefs) -> do
let bsInChunkSize :: CSize
bsInChunkSize = CSize
16CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
*CSize
1024
CSize
compressBound <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound (CSize
19 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
bsInChunkSize) ScopedLz4FramePreferencesPtr
prefs
{-# LINE 467 "src/Codec/Compression/LZ4/Conduit.hsc" #-}
let outBufferSize = max bufferSize compressBound
ForeignPtr CChar
outBuf <- IO (ForeignPtr CChar)
-> ConduitT ByteString ByteString m (ForeignPtr CChar)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignPtr CChar)
-> ConduitT ByteString ByteString m (ForeignPtr CChar))
-> IO (ForeignPtr CChar)
-> ConduitT ByteString ByteString m (ForeignPtr CChar)
forall a b. (a -> b) -> a -> b
$ Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
outBufferSize)
let withOutBuf :: (Ptr CChar -> IO a) -> m a
withOutBuf Ptr CChar -> IO a
f = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> (Ptr CChar -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
outBuf Ptr CChar -> IO a
f
let yieldOutBuf :: a -> ConduitT i ByteString m ()
yieldOutBuf a
outBufLen = do
ByteString
outBs <- (Ptr CChar -> IO ByteString) -> ConduitT i ByteString m ByteString
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO ByteString)
-> ConduitT i ByteString m ByteString)
-> (Ptr CChar -> IO ByteString)
-> ConduitT i ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> CStringLen -> IO ByteString
packCStringLen (Ptr CChar
buf, a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
outBufLen)
ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
outBs
CSize
headerSize <- (Ptr CChar -> IO CSize) -> ConduitT ByteString ByteString m CSize
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO CSize) -> ConduitT ByteString ByteString m CSize)
-> (Ptr CChar -> IO CSize)
-> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> HasCallStack =>
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin ScopedLz4FrameCompressionContext
ctx ScopedLz4FramePreferencesPtr
prefs Ptr CChar
buf CSize
outBufferSize
let writeFooterAndYield :: CSize -> ConduitT i ByteString m ()
writeFooterAndYield CSize
remainingCapacity = do
let offset :: Int
offset = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity
CSize
footerWritten <- (Ptr CChar -> IO CSize) -> ConduitT i ByteString m CSize
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO CSize) -> ConduitT i ByteString m CSize)
-> (Ptr CChar -> IO CSize) -> ConduitT i ByteString m CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> HasCallStack =>
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd ScopedLz4FrameCompressionContext
ctx (Ptr CChar
buf Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) CSize
remainingCapacity
let outBufLen :: CSize
outBufLen = CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
footerWritten
CSize -> ConduitT i ByteString m ()
forall {m :: * -> *} {a} {i}.
(MonadIO m, Integral a) =>
a -> ConduitT i ByteString m ()
yieldOutBuf CSize
outBufLen
let loop :: CSize -> ConduitT ByteString ByteString m ()
loop CSize
remainingCapacity = do
ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ByteString
Nothing -> do
CSize
footerSize <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
0 ScopedLz4FramePreferencesPtr
prefs
if CSize
remainingCapacity CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
>= CSize
footerSize
then do
CSize -> ConduitT ByteString ByteString m ()
forall {m :: * -> *} {i}.
MonadIO m =>
CSize -> ConduitT i ByteString m ()
writeFooterAndYield CSize
remainingCapacity
else do
CSize -> ConduitT ByteString ByteString m ()
forall {m :: * -> *} {a} {i}.
(MonadIO m, Integral a) =>
a -> ConduitT i ByteString m ()
yieldOutBuf (CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity)
CSize -> ConduitT ByteString ByteString m ()
forall {m :: * -> *} {i}.
MonadIO m =>
CSize -> ConduitT i ByteString m ()
writeFooterAndYield CSize
outBufferSize
Just ByteString
bs -> do
let bss :: [ByteString]
bss = Int -> ByteString -> [ByteString]
bsChunksOf (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
bsInChunkSize) ByteString
bs
CSize
newRemainingCapacity <- (CSize -> ByteString -> ConduitT ByteString ByteString m CSize)
-> CSize -> [ByteString] -> ConduitT ByteString ByteString m CSize
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CSize -> ByteString -> ConduitT ByteString ByteString m CSize
forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBs CSize
remainingCapacity [ByteString]
bss
CSize -> ConduitT ByteString ByteString m ()
loop CSize
newRemainingCapacity
compressSingleBs :: CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBs :: forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBs CSize
remainingCapacity ByteString
bs
| CSize
remainingCapacity CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSize
compressBound = do
CSize -> ConduitT i ByteString m ()
forall {m :: * -> *} {a} {i}.
(MonadIO m, Integral a) =>
a -> ConduitT i ByteString m ()
yieldOutBuf (CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity)
CSize -> ByteString -> ConduitM i ByteString m CSize
forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting CSize
outBufferSize ByteString
bs
| Bool
otherwise = do
CSize -> ByteString -> ConduitM i ByteString m CSize
forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting CSize
remainingCapacity ByteString
bs
compressSingleBsFitting :: CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting :: forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting CSize
remainingCapacity ByteString
bs = do
Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
remainingCapacity CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSize
compressBound) (ConduitT i ByteString m () -> ConduitT i ByteString m ())
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ String -> ConduitT i ByteString m ()
forall a. HasCallStack => String -> a
error String
"precondition violated"
CSize
written <- IO CSize -> ConduitM i ByteString m CSize
forall a. IO a -> ConduitT i ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitM i ByteString m CSize)
-> IO CSize -> ConduitM i ByteString m CSize
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO CSize) -> IO CSize
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO CSize) -> IO CSize)
-> (CStringLen -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bsPtr, Int
bsLen) -> do
let bsLenSize :: CSize
bsLenSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen
let offset :: Int
offset = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity
(Ptr CChar -> IO CSize) -> IO CSize
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO CSize) -> IO CSize)
-> (Ptr CChar -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> HasCallStack =>
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate ScopedLz4FrameCompressionContext
ctx (Ptr CChar
buf Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) CSize
remainingCapacity Ptr CChar
bsPtr CSize
bsLenSize
Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
written CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
remainingCapacity) (ConduitT i ByteString m () -> ConduitT i ByteString m ())
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
String -> ConduitT i ByteString m ()
forall a. HasCallStack => String -> a
error (String -> ConduitT i ByteString m ())
-> String -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"lz4fCompressUpdate wrote past buffer: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CSize, CSize) -> String
forall a. Show a => a -> String
show (CSize
written, CSize
remainingCapacity)
let newRemainingCapacity :: CSize
newRemainingCapacity = CSize
remainingCapacity CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
written
CSize -> ConduitM i ByteString m CSize
forall a. a -> ConduitT i ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
newRemainingCapacity
CSize -> ConduitT ByteString ByteString m ()
loop (CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
headerSize)
C.verbatim [r|
void haskell_lz4_freeDecompressionContext(LZ4F_dctx** ctxPtr)
{
LZ4F_dctx* ctx = *ctxPtr;
if (ctx != NULL)
{
size_t err = LZ4F_freeDecompressionContext(ctx);
if (LZ4F_isError(err))
{
fprintf(stderr, "LZ4F_freeDecompressionContext failed: %s\n", LZ4F_getErrorName(err));
exit(1);
}
}
}
|]
foreign import ccall "&haskell_lz4_freeDecompressionContext" haskell_lz4_freeDecompressionContext :: FunPtr (Ptr (Ptr LZ4F_dctx) -> IO ())
lz4fCreateDecompressionContext :: (HasCallStack) => IO Lz4FrameDecompressionContext
lz4fCreateDecompressionContext :: HasCallStack => IO Lz4FrameDecompressionContext
lz4fCreateDecompressionContext = do
ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr :: ForeignPtr (Ptr LZ4F_dctx) <- IO (ForeignPtr (Ptr LZ4F_dctx))
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
ForeignPtr (Ptr LZ4F_dctx)
-> (Ptr (Ptr LZ4F_dctx) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr ((Ptr (Ptr LZ4F_dctx) -> IO ()) -> IO ())
-> (Ptr (Ptr LZ4F_dctx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr LZ4F_dctx)
ptr -> Ptr (Ptr LZ4F_dctx) -> Ptr LZ4F_dctx -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr LZ4F_dctx)
ptr Ptr LZ4F_dctx
forall a. Ptr a
nullPtr
FinalizerPtr (Ptr LZ4F_dctx) -> ForeignPtr (Ptr LZ4F_dctx) -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr (Ptr LZ4F_dctx)
haskell_lz4_freeDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr
CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
LZ4F_dctx** ctxPtr = $fptr-ptr:(LZ4F_dctx** ctxForeignPtr);
LZ4F_errorCode_t err = LZ4F_createDecompressionContext(ctxPtr, LZ4F_VERSION);
return err;
} |]
Lz4FrameDecompressionContext -> IO Lz4FrameDecompressionContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr (Ptr LZ4F_dctx) -> Lz4FrameDecompressionContext
Lz4FrameDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr)
lz4fGetFrameInfo :: (HasCallStack) => Lz4FrameDecompressionContext -> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fGetFrameInfo :: HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fGetFrameInfo (Lz4FrameDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr) Ptr FrameInfo
frameInfoPtr Ptr CChar
srcBuffer Ptr CSize
srcSizePtr = do
CSize
decompressSizeHint <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
LZ4F_dctx* ctxPtr = *$fptr-ptr:(LZ4F_dctx** ctxForeignPtr);
LZ4F_errorCode_t err_or_decompressSizeHint = LZ4F_getFrameInfo(ctxPtr, $(LZ4F_frameInfo_t* frameInfoPtr), $(char* srcBuffer), $(size_t* srcSizePtr));
return err_or_decompressSizeHint;
} |]
CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
decompressSizeHint
lz4fDecompress :: (HasCallStack) => Lz4FrameDecompressionContext -> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fDecompress :: HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fDecompress (Lz4FrameDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr) Ptr CChar
dstBuffer Ptr CSize
dstSizePtr Ptr CChar
srcBuffer Ptr CSize
srcSizePtr = do
CSize
decompressSizeHint <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
LZ4F_dctx* ctxPtr = *$fptr-ptr:(LZ4F_dctx** ctxForeignPtr);
LZ4F_errorCode_t err_or_decompressSizeHint = LZ4F_decompress(ctxPtr, $(char* dstBuffer), $(size_t* dstSizePtr), $(char* srcBuffer), $(size_t* srcSizePtr), NULL);
return err_or_decompressSizeHint;
} |]
CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
decompressSizeHint
decompress :: forall m . (MonadUnliftIO m, MonadResource m) => ConduitT ByteString ByteString m ()
decompress :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
ConduitT ByteString ByteString m ()
decompress = do
Lz4FrameDecompressionContext
ctx <- IO Lz4FrameDecompressionContext
-> ConduitT ByteString ByteString m Lz4FrameDecompressionContext
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Lz4FrameDecompressionContext
HasCallStack => IO Lz4FrameDecompressionContext
lz4fCreateDecompressionContext
ByteString
first5Bytes <- Int -> ConduitT ByteString ByteString m ByteString
forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ByteString
CB.take Int
5
Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
BSL.length ByteString
first5Bytes Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
5) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
String -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> ConduitT ByteString ByteString m ())
-> String -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"lz4 decompress error: not enough bytes for header; expected 5, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
BSL.length ByteString
first5Bytes)
let byteFLG :: Word8
byteFLG = HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
BSL.index ByteString
first5Bytes Int64
4
let contentSizeBit :: Bool
contentSizeBit = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byteFLG Int
3
let numRemainingHeaderBytes :: Int
numRemainingHeaderBytes
| Bool
contentSizeBit = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8
| Bool
otherwise = Int
2
ByteString
remainingHeaderBytes <- Int -> ConduitT ByteString ByteString m ByteString
forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ByteString
CB.take Int
numRemainingHeaderBytes
let headerBs :: ByteString
headerBs = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BSL.concat [ByteString
first5Bytes, ByteString
remainingHeaderBytes]
CSize
headerDecompressSizeHint <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ (Ptr FrameInfo -> IO CSize) -> IO CSize
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FrameInfo -> IO CSize) -> IO CSize)
-> (Ptr FrameInfo -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr FrameInfo
frameInfoPtr -> do
ByteString -> (CStringLen -> IO CSize) -> IO CSize
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
headerBs ((CStringLen -> IO CSize) -> IO CSize)
-> (CStringLen -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
headerBsPtr, Int
headerBsLen) -> do
CSize -> (Ptr CSize -> IO CSize) -> IO CSize
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
headerBsLen :: CSize) ((Ptr CSize -> IO CSize) -> IO CSize)
-> (Ptr CSize -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
headerBsLenPtr -> do
HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
Lz4FrameDecompressionContext
-> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fGetFrameInfo Lz4FrameDecompressionContext
ctx Ptr FrameInfo
frameInfoPtr Ptr CChar
headerBsPtr Ptr CSize
headerBsLenPtr
let dstBufferSizeDefault :: CSize
dstBufferSizeDefault :: CSize
dstBufferSizeDefault = CSize
16 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
* CSize
1024
IO (Ptr (Ptr CChar), Ptr CSize)
-> ((Ptr (Ptr CChar), Ptr CSize) -> IO ())
-> ((Ptr (Ptr CChar), Ptr CSize)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
(do
Ptr (Ptr CChar)
dstBufferPtr <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
malloc
Ptr CSize
dstBufferSizePtr <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
malloc
Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
dstBufferPtr (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (Ptr CChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
dstBufferSizeDefault)
Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
dstBufferSizePtr CSize
dstBufferSizeDefault
(Ptr (Ptr CChar), Ptr CSize) -> IO (Ptr (Ptr CChar), Ptr CSize)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr (Ptr CChar)
dstBufferPtr, Ptr CSize
dstBufferSizePtr)
)
(\(Ptr (Ptr CChar)
dstBufferPtr, Ptr CSize
dstBufferSizePtr) -> do
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dstBufferPtr
Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
dstBufferPtr
Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
free Ptr CSize
dstBufferSizePtr
)
(((Ptr (Ptr CChar), Ptr CSize)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ())
-> ((Ptr (Ptr CChar), Ptr CSize)
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr CChar)
dstBufferPtr, Ptr CSize
dstBufferSizePtr) -> do
let ensureDstBufferSize :: CSize -> IO (Ptr CChar)
ensureDstBufferSize :: CSize -> IO (Ptr CChar)
ensureDstBufferSize CSize
size = do
CSize
dstBufferSize <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dstBufferSizePtr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
size CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
dstBufferSize) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Ptr CChar
dstBuffer <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dstBufferPtr
Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
dstBufferPtr (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CChar -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray Ptr CChar
dstBuffer (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size)
Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
dstBufferSizePtr CSize
size
Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dstBufferPtr
let loopSingleBs :: CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs :: CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs CSize
decompressSizeHint ByteString
bs = do
(ByteString
outBs, CSize
srcRead, CSize
newDecompressSizeHint) <- IO (ByteString, CSize, CSize)
-> ConduitT ByteString ByteString m (ByteString, CSize, CSize)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, CSize, CSize)
-> ConduitT ByteString ByteString m (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
-> ConduitT ByteString ByteString m (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$
ByteString
-> (CStringLen -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize))
-> (CStringLen -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
srcBuffer, Int
srcSize) -> do
let outBufSize :: CSize
outBufSize = CSize -> CSize -> CSize
forall a. Ord a => a -> a -> a
max CSize
decompressSizeHint CSize
dstBufferSizeDefault
Ptr CChar
dstBuffer <- CSize -> IO (Ptr CChar)
ensureDstBufferSize CSize
outBufSize
CSize
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CSize
outBufSize ((Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize))
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
dstSizePtr -> do
CSize
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcSize :: CSize) ((Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize))
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
srcSizePtr -> do
CSize
newDecompressSizeHint <-
HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
Lz4FrameDecompressionContext
-> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fDecompress Lz4FrameDecompressionContext
ctx Ptr CChar
dstBuffer Ptr CSize
dstSizePtr Ptr CChar
srcBuffer Ptr CSize
srcSizePtr
CSize
srcRead <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
srcSizePtr
CSize
dstWritten <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dstSizePtr
ByteString
outBs <- CStringLen -> IO ByteString
packCStringLen (Ptr CChar
dstBuffer, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
dstWritten)
(ByteString, CSize, CSize) -> IO (ByteString, CSize, CSize)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
outBs, CSize
srcRead, CSize
newDecompressSizeHint)
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
outBs
let srcReadInt :: Int
srcReadInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
srcRead
if
| Int
srcReadInt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
bs -> CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs CSize
newDecompressSizeHint (Int -> ByteString -> ByteString
BS.drop Int
srcReadInt ByteString
bs)
| Int
srcReadInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
bs -> CSize -> ConduitT ByteString ByteString m CSize
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
newDecompressSizeHint
| Bool
otherwise -> String -> ConduitT ByteString ByteString m CSize
forall a. HasCallStack => String -> a
error (String -> ConduitT ByteString ByteString m CSize)
-> String -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ String
"lz4 decompress: assertion failed: srcRead < BS.length bs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CSize, Int) -> String
forall a. Show a => a -> String
show (CSize
srcRead, ByteString -> Int
BS.length ByteString
bs)
let loop :: CSize -> ConduitT ByteString ByteString m ()
loop CSize
decompressSizeHint =
ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ByteString
Nothing -> String -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> ConduitT ByteString ByteString m ())
-> String -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"lz4 decompress error: stream ended before EndMark"
Just ByteString
bs -> do
CSize
newDecompressSizeHint <- CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs CSize
decompressSizeHint ByteString
bs
Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
newDecompressSizeHint CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize
0) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ CSize -> ConduitT ByteString ByteString m ()
loop CSize
newDecompressSizeHint
CSize -> ConduitT ByteString ByteString m ()
loop CSize
headerDecompressSizeHint
IO () -> ConduitT ByteString ByteString m ()
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString ByteString m ())
-> IO () -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr (Ptr LZ4F_dctx) -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr (Lz4FrameDecompressionContext -> ForeignPtr (Ptr LZ4F_dctx)
unLz4FrameDecompressionContext Lz4FrameDecompressionContext
ctx)