{-# LINE 1 "src/LibBrotli.hsc" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module LibBrotli
( CompressParams(..), defaultCompressParams
, CompressionLevel(..), CompressionWindowSize(..), CompressionMode(..)
, DecompressParams(..), defaultDecompressParams
, BrotliState(..), BrotliEncOp(..)
, newBrotliEncoder, newBrotliDecoder
, finalizeBrotliEncoder, finalizeBrotliDecoder
, runBrotliEncoder, runBrotliDecoder
, readBrotliEncoder, readBrotliDecoder
, brotliEncoderVersion, brotliDecoderVersion
, BrotliDecoderErrorCode(..), showBrotliDecoderErrorCode
) where
import Control.Applicative
import Control.Monad
import Control.Exception
import Control.Monad.ST.Strict (ST)
import Control.Monad.ST.Unsafe (unsafeIOToST)
import Data.ByteString (ByteString)
import Data.Typeable (Typeable)
import Foreign
import Foreign.C
import System.IO.Unsafe as Unsafe (unsafePerformIO)
import Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Control.Monad.Trans.Maybe (MaybeT(..))
packBS :: Ptr Word8 -> CSize -> IO ByteString
packBS :: Ptr Word8 -> CSize -> IO ByteString
packBS Ptr Word8
p CSize
sz
| CSize
sz CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
0 = CStringLen -> IO ByteString
BS.packCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz)
| Bool
otherwise = ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BS.empty
type BrotliBool = Int32
{-# LINE 60 "src/LibBrotli.hsc" #-}
fromBrotliBool :: BrotliBool -> Maybe Bool
fromBrotliBool :: Int32 -> Maybe Bool
fromBrotliBool Int32
1 = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
{-# LINE 63 "src/LibBrotli.hsc" #-}
fromBrotliBool 0 = Just False
{-# LINE 64 "src/LibBrotli.hsc" #-}
fromBrotliBool _ = Nothing
toBrotliBool :: Bool -> BrotliBool
toBrotliBool :: Bool -> Int32
toBrotliBool Bool
False = Int32
0
{-# LINE 68 "src/LibBrotli.hsc" #-}
toBrotliBool True = 1
{-# LINE 69 "src/LibBrotli.hsc" #-}
newtype BrotliDecoderErrorCode = BrotliDecoderErrorCode Int deriving (BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool
(BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool)
-> (BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool)
-> Eq BrotliDecoderErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool
== :: BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool
$c/= :: BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool
/= :: BrotliDecoderErrorCode -> BrotliDecoderErrorCode -> Bool
Eq,Int -> BrotliDecoderErrorCode -> ShowS
[BrotliDecoderErrorCode] -> ShowS
BrotliDecoderErrorCode -> String
(Int -> BrotliDecoderErrorCode -> ShowS)
-> (BrotliDecoderErrorCode -> String)
-> ([BrotliDecoderErrorCode] -> ShowS)
-> Show BrotliDecoderErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BrotliDecoderErrorCode -> ShowS
showsPrec :: Int -> BrotliDecoderErrorCode -> ShowS
$cshow :: BrotliDecoderErrorCode -> String
show :: BrotliDecoderErrorCode -> String
$cshowList :: [BrotliDecoderErrorCode] -> ShowS
showList :: [BrotliDecoderErrorCode] -> ShowS
Show,Typeable)
instance Exception BrotliDecoderErrorCode
{-# NOINLINE showBrotliDecoderErrorCode #-}
showBrotliDecoderErrorCode :: BrotliDecoderErrorCode -> String
showBrotliDecoderErrorCode :: BrotliDecoderErrorCode -> String
showBrotliDecoderErrorCode (BrotliDecoderErrorCode Int
ec) = IO String -> String
forall a. IO a -> a
Unsafe.unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
bufptr <- Int32 -> IO CString
c_BrotliDecoderErrorString (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ec)
if bufptr == nullPtr then pure "" else peekCAString bufptr
data BrotliState
= BSNeedsInput
| BSHasOutput
| BSFinished
| BSFail
| BSInternalError
deriving (BrotliState -> BrotliState -> Bool
(BrotliState -> BrotliState -> Bool)
-> (BrotliState -> BrotliState -> Bool) -> Eq BrotliState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BrotliState -> BrotliState -> Bool
== :: BrotliState -> BrotliState -> Bool
$c/= :: BrotliState -> BrotliState -> Bool
/= :: BrotliState -> BrotliState -> Bool
Eq,Int -> BrotliState -> ShowS
[BrotliState] -> ShowS
BrotliState -> String
(Int -> BrotliState -> ShowS)
-> (BrotliState -> String)
-> ([BrotliState] -> ShowS)
-> Show BrotliState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BrotliState -> ShowS
showsPrec :: Int -> BrotliState -> ShowS
$cshow :: BrotliState -> String
show :: BrotliState -> String
$cshowList :: [BrotliState] -> ShowS
showList :: [BrotliState] -> ShowS
Show)
type HsBrotliState = Word32
{-# LINE 96 "src/LibBrotli.hsc" #-}
fromHsBrotliState :: HsBrotliState -> BrotliState
fromHsBrotliState :: HsBrotliState -> BrotliState
fromHsBrotliState HsBrotliState
x = case HsBrotliState
x of
HsBrotliState
0 -> BrotliState
BSNeedsInput
{-# LINE 100 "src/LibBrotli.hsc" #-}
1 -> BSHasOutput
{-# LINE 101 "src/LibBrotli.hsc" #-}
2 -> BSFinished
{-# LINE 102 "src/LibBrotli.hsc" #-}
3 -> BSFail
{-# LINE 103 "src/LibBrotli.hsc" #-}
_ -> BSInternalError
data CompressParams = CompressParams
{ CompressParams -> CompressionLevel
compressLevel :: !CompressionLevel
, CompressParams -> CompressionWindowSize
compressWindowSize :: !CompressionWindowSize
, CompressParams -> CompressionMode
compressMode :: !CompressionMode
, CompressParams -> HsBrotliState
compressSizeHint :: !Word32
}
data DecompressParams = DecompressParams
{ DecompressParams -> Bool
decompressDisableRingBufferReallocation :: !Bool
}
defaultCompressParams :: CompressParams
defaultCompressParams :: CompressParams
defaultCompressParams = CompressParams {HsBrotliState
CompressionWindowSize
CompressionLevel
CompressionMode
compressLevel :: CompressionLevel
compressWindowSize :: CompressionWindowSize
compressMode :: CompressionMode
compressSizeHint :: HsBrotliState
compressLevel :: CompressionLevel
compressWindowSize :: CompressionWindowSize
compressMode :: CompressionMode
compressSizeHint :: HsBrotliState
..}
where
compressLevel :: CompressionLevel
compressLevel = CompressionLevel
forall a. Bounded a => a
maxBound
compressWindowSize :: CompressionWindowSize
compressWindowSize = CompressionWindowSize
CompressionWindowBits22
compressMode :: CompressionMode
compressMode = CompressionMode
CompressionModeGeneric
compressSizeHint :: HsBrotliState
compressSizeHint = HsBrotliState
0
defaultDecompressParams :: DecompressParams
defaultDecompressParams :: DecompressParams
defaultDecompressParams = Bool -> DecompressParams
DecompressParams Bool
False
newtype BrotliEncoder = BrotliEncoder (ForeignPtr BrotliEncoder)
newtype BrotliDecoder = BrotliDecoder (ForeignPtr BrotliDecoder)
newBrotliEncoder :: CompressParams -> ST s (Maybe BrotliEncoder)
newBrotliEncoder :: forall s. CompressParams -> ST s (Maybe BrotliEncoder)
newBrotliEncoder CompressParams{HsBrotliState
CompressionWindowSize
CompressionLevel
CompressionMode
compressLevel :: CompressParams -> CompressionLevel
compressWindowSize :: CompressParams -> CompressionWindowSize
compressMode :: CompressParams -> CompressionMode
compressSizeHint :: CompressParams -> HsBrotliState
compressLevel :: CompressionLevel
compressWindowSize :: CompressionWindowSize
compressMode :: CompressionMode
compressSizeHint :: HsBrotliState
..} = IO (Maybe BrotliEncoder) -> ST s (Maybe BrotliEncoder)
forall a s. IO a -> ST s a
unsafeIOToST (IO (Maybe BrotliEncoder) -> ST s (Maybe BrotliEncoder))
-> IO (Maybe BrotliEncoder) -> ST s (Maybe BrotliEncoder)
forall a b. (a -> b) -> a -> b
$ MaybeT IO BrotliEncoder -> IO (Maybe BrotliEncoder)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO BrotliEncoder -> IO (Maybe BrotliEncoder))
-> MaybeT IO BrotliEncoder -> IO (Maybe BrotliEncoder)
forall a b. (a -> b) -> a -> b
$ do
fp <- IO (Maybe BrotliEncoder) -> MaybeT IO BrotliEncoder
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe BrotliEncoder)
createBrotliEncoder
unless (11 == qualityParm) $ do
{-# LINE 149 "src/LibBrotli.hsc" #-}
rc <- setParm fp 1 qualityParm
{-# LINE 150 "src/LibBrotli.hsc" #-}
unless rc $ fail "invalid BROTLI_PARAM_QUALITY"
unless (0 == modeParm) $ do
{-# LINE 153 "src/LibBrotli.hsc" #-}
rc <- setParm fp 0 modeParm
{-# LINE 154 "src/LibBrotli.hsc" #-}
unless rc $ fail "invalid BROTLI_PARAM_MODE"
unless (22 == winParm) $ do
{-# LINE 157 "src/LibBrotli.hsc" #-}
unless ((10 <= winParm) && (winParm <= 24)) $
{-# LINE 158 "src/LibBrotli.hsc" #-}
fail "invalid BROTLI_PARAM_LGWIN (internal inconsistency)"
rc <- setParm fp 2 winParm
{-# LINE 161 "src/LibBrotli.hsc" #-}
unless rc $ fail "invalid BROTLI_PARAM_LGWIN"
unless (0 == compressSizeHint) $ do
rc <- setParm fp 5 compressSizeHint
{-# LINE 165 "src/LibBrotli.hsc" #-}
unless rc $ fail "invalid BROTLI_PARAM_SIZE_HINT"
pure fp
where
setParm :: BrotliEncoder -> HsBrotliState -> HsBrotliState -> MaybeT IO Bool
setParm (BrotliEncoder ForeignPtr BrotliEncoder
fp) HsBrotliState
k HsBrotliState
v = IO (Maybe Bool) -> MaybeT IO Bool
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ForeignPtr BrotliEncoder
-> (Ptr BrotliEncoder -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BrotliEncoder
fp ((Ptr BrotliEncoder -> IO (Maybe Bool)) -> IO (Maybe Bool))
-> (Ptr BrotliEncoder -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr BrotliEncoder
p -> Int32 -> Maybe Bool
fromBrotliBool (Int32 -> Maybe Bool) -> IO Int32 -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr BrotliEncoder -> HsBrotliState -> HsBrotliState -> IO Int32
c_BrotliEncoderSetParameter Ptr BrotliEncoder
p HsBrotliState
k HsBrotliState
v)
qualityParm :: HsBrotliState
qualityParm = Int -> HsBrotliState
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CompressionLevel -> Int
forall a. Enum a => a -> Int
fromEnum CompressionLevel
compressLevel)
winParm :: HsBrotliState
winParm = Int -> HsBrotliState
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CompressionWindowSize -> Int
forall a. Enum a => a -> Int
fromEnum CompressionWindowSize
compressWindowSize)
modeParm :: HsBrotliState
modeParm = case CompressionMode
compressMode of
CompressionMode
CompressionModeGeneric -> HsBrotliState
0
{-# LINE 175 "src/LibBrotli.hsc" #-}
CompressionMode
CompressionModeText -> HsBrotliState
1
{-# LINE 176 "src/LibBrotli.hsc" #-}
CompressionMode
CompressionModeFont -> HsBrotliState
2
{-# LINE 177 "src/LibBrotli.hsc" #-}
newBrotliDecoder :: DecompressParams -> ST s (Maybe BrotliDecoder)
newBrotliDecoder :: forall s. DecompressParams -> ST s (Maybe BrotliDecoder)
newBrotliDecoder DecompressParams{Bool
decompressDisableRingBufferReallocation :: DecompressParams -> Bool
decompressDisableRingBufferReallocation :: Bool
..} = IO (Maybe BrotliDecoder) -> ST s (Maybe BrotliDecoder)
forall a s. IO a -> ST s a
unsafeIOToST (IO (Maybe BrotliDecoder) -> ST s (Maybe BrotliDecoder))
-> IO (Maybe BrotliDecoder) -> ST s (Maybe BrotliDecoder)
forall a b. (a -> b) -> a -> b
$ MaybeT IO BrotliDecoder -> IO (Maybe BrotliDecoder)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO BrotliDecoder -> IO (Maybe BrotliDecoder))
-> MaybeT IO BrotliDecoder -> IO (Maybe BrotliDecoder)
forall a b. (a -> b) -> a -> b
$ do
fp <- IO (Maybe BrotliDecoder) -> MaybeT IO BrotliDecoder
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe BrotliDecoder)
createBrotliDecoder
when decompressDisableRingBufferReallocation $ do
rc <- setParm fp 0
{-# LINE 184 "src/LibBrotli.hsc" #-}
(fromIntegral $ toBrotliBool decompressDisableRingBufferReallocation)
unless rc $ fail "invalid BROTLI_DECODER_PARAM_DISABLE_RING_BUFFER_REALLOCATION"
pure fp
where
setParm :: BrotliDecoder -> HsBrotliState -> HsBrotliState -> MaybeT IO Bool
setParm (BrotliDecoder ForeignPtr BrotliDecoder
fp) HsBrotliState
k HsBrotliState
v = IO (Maybe Bool) -> MaybeT IO Bool
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ForeignPtr BrotliDecoder
-> (Ptr BrotliDecoder -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BrotliDecoder
fp ((Ptr BrotliDecoder -> IO (Maybe Bool)) -> IO (Maybe Bool))
-> (Ptr BrotliDecoder -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ \Ptr BrotliDecoder
p -> Int32 -> Maybe Bool
fromBrotliBool (Int32 -> Maybe Bool) -> IO Int32 -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr BrotliDecoder -> HsBrotliState -> HsBrotliState -> IO Int32
c_BrotliDecoderSetParameter Ptr BrotliDecoder
p HsBrotliState
k HsBrotliState
v)
createBrotliEncoder :: IO (Maybe BrotliEncoder)
createBrotliEncoder :: IO (Maybe BrotliEncoder)
createBrotliEncoder = IO (Maybe BrotliEncoder) -> IO (Maybe BrotliEncoder)
forall a. IO a -> IO a
mask_ (IO (Maybe BrotliEncoder) -> IO (Maybe BrotliEncoder))
-> IO (Maybe BrotliEncoder) -> IO (Maybe BrotliEncoder)
forall a b. (a -> b) -> a -> b
$ do
p <- Ptr () -> Ptr () -> Ptr () -> IO (Ptr BrotliEncoder)
c_BrotliEncoderCreateInstance Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr
case () of
()
_ | Ptr BrotliEncoder
p Ptr BrotliEncoder -> Ptr BrotliEncoder -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr BrotliEncoder
forall a. Ptr a
nullPtr -> Maybe BrotliEncoder -> IO (Maybe BrotliEncoder)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BrotliEncoder
forall a. Maybe a
Nothing
| Bool
otherwise -> do
!fp <- FinalizerPtr BrotliEncoder
-> Ptr BrotliEncoder -> IO (ForeignPtr BrotliEncoder)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr BrotliEncoder
cp_BrotliEncoderDestroyInstance Ptr BrotliEncoder
p
pure (Just (BrotliEncoder fp))
createBrotliDecoder :: IO (Maybe BrotliDecoder)
createBrotliDecoder :: IO (Maybe BrotliDecoder)
createBrotliDecoder = IO (Maybe BrotliDecoder) -> IO (Maybe BrotliDecoder)
forall a. IO a -> IO a
mask_ (IO (Maybe BrotliDecoder) -> IO (Maybe BrotliDecoder))
-> IO (Maybe BrotliDecoder) -> IO (Maybe BrotliDecoder)
forall a b. (a -> b) -> a -> b
$ do
p <- Ptr () -> Ptr () -> Ptr () -> IO (Ptr BrotliDecoder)
c_BrotliDecoderCreateInstance Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr
case () of
()
_ | Ptr BrotliDecoder
p Ptr BrotliDecoder -> Ptr BrotliDecoder -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr BrotliDecoder
forall a. Ptr a
nullPtr -> Maybe BrotliDecoder -> IO (Maybe BrotliDecoder)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BrotliDecoder
forall a. Maybe a
Nothing
| Bool
otherwise -> do
!fp <- FinalizerPtr BrotliDecoder
-> Ptr BrotliDecoder -> IO (ForeignPtr BrotliDecoder)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr BrotliDecoder
cp_BrotliDecoderDestroyInstance Ptr BrotliDecoder
p
pure (Just (BrotliDecoder fp))
finalizeBrotliEncoder :: BrotliEncoder -> ST s ()
finalizeBrotliEncoder :: forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder (BrotliEncoder ForeignPtr BrotliEncoder
s) = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (ForeignPtr BrotliEncoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr BrotliEncoder
s)
finalizeBrotliDecoder :: BrotliDecoder -> ST s ()
finalizeBrotliDecoder :: forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder (BrotliDecoder ForeignPtr BrotliDecoder
s) = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (ForeignPtr BrotliDecoder -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr BrotliDecoder
s)
data BrotliEncOp
= BrotliEncOpProcess
| BrotliEncOpFlush
| BrotliEncOpFinish
runBrotliEncoder :: BrotliEncoder
-> ByteString
-> BrotliEncOp
-> ST s (BrotliState,Int)
runBrotliEncoder :: forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder (BrotliEncoder ForeignPtr BrotliEncoder
fp) ByteString
ibs BrotliEncOp
action0
= IO (BrotliState, Int) -> ST s (BrotliState, Int)
forall a s. IO a -> ST s a
unsafeIOToST (IO (BrotliState, Int) -> ST s (BrotliState, Int))
-> IO (BrotliState, Int) -> ST s (BrotliState, Int)
forall a b. (a -> b) -> a -> b
$ ForeignPtr BrotliEncoder
-> (Ptr BrotliEncoder -> IO (BrotliState, Int))
-> IO (BrotliState, Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BrotliEncoder
fp ((Ptr BrotliEncoder -> IO (BrotliState, Int))
-> IO (BrotliState, Int))
-> (Ptr BrotliEncoder -> IO (BrotliState, Int))
-> IO (BrotliState, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr BrotliEncoder
encPtr -> do
ByteString
-> (CStringLen -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
ibs ((CStringLen -> IO (BrotliState, Int)) -> IO (BrotliState, Int))
-> (CStringLen -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a b. (a -> b) -> a -> b
$ \(CString
ibsptr, Int
ibslen) ->
CSize
-> (Ptr CSize -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
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
ibslen) ((Ptr CSize -> IO (BrotliState, Int)) -> IO (BrotliState, Int))
-> (Ptr CSize -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
availIn ->
CString
-> (Ptr CString -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CString
ibsptr ((Ptr CString -> IO (BrotliState, Int)) -> IO (BrotliState, Int))
-> (Ptr CString -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
nextIn -> do
CSize
-> (Ptr CSize -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CSize
0 ((Ptr CSize -> IO (BrotliState, Int)) -> IO (BrotliState, Int))
-> (Ptr CSize -> IO (BrotliState, Int)) -> IO (BrotliState, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
availOut -> do
rc <- HsBrotliState -> BrotliState
fromHsBrotliState (HsBrotliState -> BrotliState)
-> IO HsBrotliState -> IO BrotliState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Ptr BrotliEncoder
-> HsBrotliState
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> IO HsBrotliState
c_BrotliEncoderCompressStream Ptr BrotliEncoder
encPtr HsBrotliState
action Ptr CSize
availIn (Ptr CString -> Ptr (Ptr Word8)
forall a b. Ptr a -> Ptr b
castPtr Ptr CString
nextIn) Ptr CSize
availOut Ptr (Ptr Word8)
forall a. Ptr a
nullPtr Ptr CSize
forall a. Ptr a
nullPtr
availIn' <- fromIntegral <$> peek availIn
pure (rc, availIn')
where
action :: HsBrotliState
action = case BrotliEncOp
action0 of
BrotliEncOp
BrotliEncOpProcess -> HsBrotliState
0
{-# LINE 238 "src/LibBrotli.hsc" #-}
BrotliEncOp
BrotliEncOpFinish -> HsBrotliState
2
{-# LINE 239 "src/LibBrotli.hsc" #-}
BrotliEncOp
BrotliEncOpFlush -> HsBrotliState
1
{-# LINE 240 "src/LibBrotli.hsc" #-}
runBrotliDecoder :: BrotliDecoder
-> ByteString
-> ST s (BrotliState,BrotliDecoderErrorCode,Int )
runBrotliDecoder :: forall s.
BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder (BrotliDecoder ForeignPtr BrotliDecoder
fp) ByteString
ibs
= IO (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall a s. IO a -> ST s a
unsafeIOToST (IO (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. (a -> b) -> a -> b
$ ForeignPtr BrotliDecoder
-> (Ptr BrotliDecoder
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BrotliDecoder
fp ((Ptr BrotliDecoder
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> (Ptr BrotliDecoder
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr BrotliDecoder
encPtr -> do
ByteString
-> (CStringLen -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
ibs ((CStringLen -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> (CStringLen -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. (a -> b) -> a -> b
$ \(CString
ibsptr, Int
ibslen) ->
CSize
-> (Ptr CSize -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
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
ibslen) ((Ptr CSize -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> (Ptr CSize -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
availIn ->
CString
-> (Ptr CString -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CString
ibsptr ((Ptr CString -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> (Ptr CString -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
nextIn -> do
CSize
-> (Ptr CSize -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CSize
0 ((Ptr CSize -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> (Ptr CSize -> IO (BrotliState, BrotliDecoderErrorCode, Int))
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
availOut -> do
rc <- HsBrotliState -> BrotliState
fromHsBrotliState (HsBrotliState -> BrotliState)
-> IO HsBrotliState -> IO BrotliState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Ptr BrotliDecoder
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> IO HsBrotliState
c_BrotliDecoderDecompressStream Ptr BrotliDecoder
encPtr Ptr CSize
availIn (Ptr CString -> Ptr (Ptr Word8)
forall a b. Ptr a -> Ptr b
castPtr Ptr CString
nextIn) Ptr CSize
availOut Ptr (Ptr Word8)
forall a. Ptr a
nullPtr Ptr CSize
forall a. Ptr a
nullPtr
availIn' <- fromIntegral <$> peek availIn
ecode <- BrotliDecoderErrorCode <$> if rc == BSFail
then fromIntegral <$> c_BrotliDecoderGetErrorCode encPtr
else pure 0
pure (rc, ecode, availIn')
readBrotliEncoder :: BrotliEncoder -> Int -> ST s (BrotliState, ByteString)
readBrotliEncoder :: forall s. BrotliEncoder -> Int -> ST s (BrotliState, ByteString)
readBrotliEncoder (BrotliEncoder ForeignPtr BrotliEncoder
fp) Int
maxobs
= IO (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall a s. IO a -> ST s a
unsafeIOToST (IO (BrotliState, ByteString) -> ST s (BrotliState, ByteString))
-> IO (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr BrotliEncoder
-> (Ptr BrotliEncoder -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BrotliEncoder
fp ((Ptr BrotliEncoder -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString))
-> (Ptr BrotliEncoder -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr BrotliEncoder
encPtr -> do
CSize
-> (Ptr CSize -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
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
maxobs) ((Ptr CSize -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString))
-> (Ptr CSize -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
availOutPtr -> do
(Ptr (Ptr Word8) -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr Word8) -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString))
-> (Ptr (Ptr Word8) -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
obsptrptr -> do
rc <- HsBrotliState -> BrotliState
fromHsBrotliState (HsBrotliState -> BrotliState)
-> IO HsBrotliState -> IO BrotliState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Ptr BrotliEncoder
-> Ptr CSize -> Ptr (Ptr Word8) -> IO HsBrotliState
c_BrotliEncoderTakeOutput Ptr BrotliEncoder
encPtr Ptr CSize
availOutPtr Ptr (Ptr Word8)
obsptrptr
availOut' <- peek availOutPtr
obsptr <- peek obsptrptr
buf <- packBS obsptr availOut'
pure (rc, buf)
readBrotliDecoder :: BrotliDecoder -> Int -> ST s (BrotliState, ByteString)
readBrotliDecoder :: forall s. BrotliDecoder -> Int -> ST s (BrotliState, ByteString)
readBrotliDecoder (BrotliDecoder ForeignPtr BrotliDecoder
fp) Int
maxobs
= IO (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall a s. IO a -> ST s a
unsafeIOToST (IO (BrotliState, ByteString) -> ST s (BrotliState, ByteString))
-> IO (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr BrotliDecoder
-> (Ptr BrotliDecoder -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BrotliDecoder
fp ((Ptr BrotliDecoder -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString))
-> (Ptr BrotliDecoder -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr BrotliDecoder
encPtr -> do
CSize
-> (Ptr CSize -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
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
maxobs) ((Ptr CSize -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString))
-> (Ptr CSize -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
availOutPtr -> do
(Ptr (Ptr Word8) -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr Word8) -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString))
-> (Ptr (Ptr Word8) -> IO (BrotliState, ByteString))
-> IO (BrotliState, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
obsptrptr -> do
rc <- HsBrotliState -> BrotliState
fromHsBrotliState (HsBrotliState -> BrotliState)
-> IO HsBrotliState -> IO BrotliState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Ptr BrotliDecoder
-> Ptr CSize -> Ptr (Ptr Word8) -> IO HsBrotliState
c_BrotliDecoderTakeOutput Ptr BrotliDecoder
encPtr Ptr CSize
availOutPtr Ptr (Ptr Word8)
obsptrptr
availOut' <- peek availOutPtr
obsptr <- peek obsptrptr
buf <- packBS obsptr availOut'
pure (rc, buf)
data CompressionMode
= CompressionModeGeneric
| CompressionModeText
| CompressionModeFont
deriving (CompressionMode -> CompressionMode -> Bool
(CompressionMode -> CompressionMode -> Bool)
-> (CompressionMode -> CompressionMode -> Bool)
-> Eq CompressionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionMode -> CompressionMode -> Bool
== :: CompressionMode -> CompressionMode -> Bool
$c/= :: CompressionMode -> CompressionMode -> Bool
/= :: CompressionMode -> CompressionMode -> Bool
Eq,ReadPrec [CompressionMode]
ReadPrec CompressionMode
Int -> ReadS CompressionMode
ReadS [CompressionMode]
(Int -> ReadS CompressionMode)
-> ReadS [CompressionMode]
-> ReadPrec CompressionMode
-> ReadPrec [CompressionMode]
-> Read CompressionMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompressionMode
readsPrec :: Int -> ReadS CompressionMode
$creadList :: ReadS [CompressionMode]
readList :: ReadS [CompressionMode]
$creadPrec :: ReadPrec CompressionMode
readPrec :: ReadPrec CompressionMode
$creadListPrec :: ReadPrec [CompressionMode]
readListPrec :: ReadPrec [CompressionMode]
Read,Int -> CompressionMode -> ShowS
[CompressionMode] -> ShowS
CompressionMode -> String
(Int -> CompressionMode -> ShowS)
-> (CompressionMode -> String)
-> ([CompressionMode] -> ShowS)
-> Show CompressionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressionMode -> ShowS
showsPrec :: Int -> CompressionMode -> ShowS
$cshow :: CompressionMode -> String
show :: CompressionMode -> String
$cshowList :: [CompressionMode] -> ShowS
showList :: [CompressionMode] -> ShowS
Show,Typeable)
data CompressionLevel
= CompressionLevel0
| CompressionLevel1
| CompressionLevel2
| CompressionLevel3
| CompressionLevel4
| CompressionLevel5
| CompressionLevel6
| CompressionLevel7
| CompressionLevel8
| CompressionLevel9
| CompressionLevel10
| CompressionLevel11
deriving (CompressionLevel -> CompressionLevel -> Bool
(CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> Eq CompressionLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionLevel -> CompressionLevel -> Bool
== :: CompressionLevel -> CompressionLevel -> Bool
$c/= :: CompressionLevel -> CompressionLevel -> Bool
/= :: CompressionLevel -> CompressionLevel -> Bool
Eq,Eq CompressionLevel
Eq CompressionLevel =>
(CompressionLevel -> CompressionLevel -> Ordering)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> Ord CompressionLevel
CompressionLevel -> CompressionLevel -> Bool
CompressionLevel -> CompressionLevel -> Ordering
CompressionLevel -> CompressionLevel -> CompressionLevel
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 :: CompressionLevel -> CompressionLevel -> Ordering
compare :: CompressionLevel -> CompressionLevel -> Ordering
$c< :: CompressionLevel -> CompressionLevel -> Bool
< :: CompressionLevel -> CompressionLevel -> Bool
$c<= :: CompressionLevel -> CompressionLevel -> Bool
<= :: CompressionLevel -> CompressionLevel -> Bool
$c> :: CompressionLevel -> CompressionLevel -> Bool
> :: CompressionLevel -> CompressionLevel -> Bool
$c>= :: CompressionLevel -> CompressionLevel -> Bool
>= :: CompressionLevel -> CompressionLevel -> Bool
$cmax :: CompressionLevel -> CompressionLevel -> CompressionLevel
max :: CompressionLevel -> CompressionLevel -> CompressionLevel
$cmin :: CompressionLevel -> CompressionLevel -> CompressionLevel
min :: CompressionLevel -> CompressionLevel -> CompressionLevel
Ord,ReadPrec [CompressionLevel]
ReadPrec CompressionLevel
Int -> ReadS CompressionLevel
ReadS [CompressionLevel]
(Int -> ReadS CompressionLevel)
-> ReadS [CompressionLevel]
-> ReadPrec CompressionLevel
-> ReadPrec [CompressionLevel]
-> Read CompressionLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompressionLevel
readsPrec :: Int -> ReadS CompressionLevel
$creadList :: ReadS [CompressionLevel]
readList :: ReadS [CompressionLevel]
$creadPrec :: ReadPrec CompressionLevel
readPrec :: ReadPrec CompressionLevel
$creadListPrec :: ReadPrec [CompressionLevel]
readListPrec :: ReadPrec [CompressionLevel]
Read,Int -> CompressionLevel -> ShowS
[CompressionLevel] -> ShowS
CompressionLevel -> String
(Int -> CompressionLevel -> ShowS)
-> (CompressionLevel -> String)
-> ([CompressionLevel] -> ShowS)
-> Show CompressionLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressionLevel -> ShowS
showsPrec :: Int -> CompressionLevel -> ShowS
$cshow :: CompressionLevel -> String
show :: CompressionLevel -> String
$cshowList :: [CompressionLevel] -> ShowS
showList :: [CompressionLevel] -> ShowS
Show,Int -> CompressionLevel
CompressionLevel -> Int
CompressionLevel -> [CompressionLevel]
CompressionLevel -> CompressionLevel
CompressionLevel -> CompressionLevel -> [CompressionLevel]
CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel]
(CompressionLevel -> CompressionLevel)
-> (CompressionLevel -> CompressionLevel)
-> (Int -> CompressionLevel)
-> (CompressionLevel -> Int)
-> (CompressionLevel -> [CompressionLevel])
-> (CompressionLevel -> CompressionLevel -> [CompressionLevel])
-> (CompressionLevel -> CompressionLevel -> [CompressionLevel])
-> (CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel])
-> Enum CompressionLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CompressionLevel -> CompressionLevel
succ :: CompressionLevel -> CompressionLevel
$cpred :: CompressionLevel -> CompressionLevel
pred :: CompressionLevel -> CompressionLevel
$ctoEnum :: Int -> CompressionLevel
toEnum :: Int -> CompressionLevel
$cfromEnum :: CompressionLevel -> Int
fromEnum :: CompressionLevel -> Int
$cenumFrom :: CompressionLevel -> [CompressionLevel]
enumFrom :: CompressionLevel -> [CompressionLevel]
$cenumFromThen :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
enumFromThen :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
$cenumFromTo :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
enumFromTo :: CompressionLevel -> CompressionLevel -> [CompressionLevel]
$cenumFromThenTo :: CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel]
enumFromThenTo :: CompressionLevel
-> CompressionLevel -> CompressionLevel -> [CompressionLevel]
Enum,Typeable,CompressionLevel
CompressionLevel -> CompressionLevel -> Bounded CompressionLevel
forall a. a -> a -> Bounded a
$cminBound :: CompressionLevel
minBound :: CompressionLevel
$cmaxBound :: CompressionLevel
maxBound :: CompressionLevel
Bounded)
data CompressionWindowSize
= CompressionWindowBits10
| CompressionWindowBits11
| CompressionWindowBits12
| CompressionWindowBits13
| CompressionWindowBits14
| CompressionWindowBits15
| CompressionWindowBits16
| CompressionWindowBits17
| CompressionWindowBits18
| CompressionWindowBits19
| CompressionWindowBits20
| CompressionWindowBits21
| CompressionWindowBits22
| CompressionWindowBits23
| CompressionWindowBits24
deriving (CompressionWindowSize -> CompressionWindowSize -> Bool
(CompressionWindowSize -> CompressionWindowSize -> Bool)
-> (CompressionWindowSize -> CompressionWindowSize -> Bool)
-> Eq CompressionWindowSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionWindowSize -> CompressionWindowSize -> Bool
== :: CompressionWindowSize -> CompressionWindowSize -> Bool
$c/= :: CompressionWindowSize -> CompressionWindowSize -> Bool
/= :: CompressionWindowSize -> CompressionWindowSize -> Bool
Eq,Eq CompressionWindowSize
Eq CompressionWindowSize =>
(CompressionWindowSize -> CompressionWindowSize -> Ordering)
-> (CompressionWindowSize -> CompressionWindowSize -> Bool)
-> (CompressionWindowSize -> CompressionWindowSize -> Bool)
-> (CompressionWindowSize -> CompressionWindowSize -> Bool)
-> (CompressionWindowSize -> CompressionWindowSize -> Bool)
-> (CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize)
-> (CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize)
-> Ord CompressionWindowSize
CompressionWindowSize -> CompressionWindowSize -> Bool
CompressionWindowSize -> CompressionWindowSize -> Ordering
CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize
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 :: CompressionWindowSize -> CompressionWindowSize -> Ordering
compare :: CompressionWindowSize -> CompressionWindowSize -> Ordering
$c< :: CompressionWindowSize -> CompressionWindowSize -> Bool
< :: CompressionWindowSize -> CompressionWindowSize -> Bool
$c<= :: CompressionWindowSize -> CompressionWindowSize -> Bool
<= :: CompressionWindowSize -> CompressionWindowSize -> Bool
$c> :: CompressionWindowSize -> CompressionWindowSize -> Bool
> :: CompressionWindowSize -> CompressionWindowSize -> Bool
$c>= :: CompressionWindowSize -> CompressionWindowSize -> Bool
>= :: CompressionWindowSize -> CompressionWindowSize -> Bool
$cmax :: CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize
max :: CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize
$cmin :: CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize
min :: CompressionWindowSize
-> CompressionWindowSize -> CompressionWindowSize
Ord,ReadPrec [CompressionWindowSize]
ReadPrec CompressionWindowSize
Int -> ReadS CompressionWindowSize
ReadS [CompressionWindowSize]
(Int -> ReadS CompressionWindowSize)
-> ReadS [CompressionWindowSize]
-> ReadPrec CompressionWindowSize
-> ReadPrec [CompressionWindowSize]
-> Read CompressionWindowSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompressionWindowSize
readsPrec :: Int -> ReadS CompressionWindowSize
$creadList :: ReadS [CompressionWindowSize]
readList :: ReadS [CompressionWindowSize]
$creadPrec :: ReadPrec CompressionWindowSize
readPrec :: ReadPrec CompressionWindowSize
$creadListPrec :: ReadPrec [CompressionWindowSize]
readListPrec :: ReadPrec [CompressionWindowSize]
Read,Int -> CompressionWindowSize -> ShowS
[CompressionWindowSize] -> ShowS
CompressionWindowSize -> String
(Int -> CompressionWindowSize -> ShowS)
-> (CompressionWindowSize -> String)
-> ([CompressionWindowSize] -> ShowS)
-> Show CompressionWindowSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressionWindowSize -> ShowS
showsPrec :: Int -> CompressionWindowSize -> ShowS
$cshow :: CompressionWindowSize -> String
show :: CompressionWindowSize -> String
$cshowList :: [CompressionWindowSize] -> ShowS
showList :: [CompressionWindowSize] -> ShowS
Show,Typeable,CompressionWindowSize
CompressionWindowSize
-> CompressionWindowSize -> Bounded CompressionWindowSize
forall a. a -> a -> Bounded a
$cminBound :: CompressionWindowSize
minBound :: CompressionWindowSize
$cmaxBound :: CompressionWindowSize
maxBound :: CompressionWindowSize
Bounded)
instance Enum CompressionWindowSize where
toEnum :: Int -> CompressionWindowSize
toEnum Int
i = case Int
i of
Int
10 -> CompressionWindowSize
CompressionWindowBits10
Int
11 -> CompressionWindowSize
CompressionWindowBits11
Int
12 -> CompressionWindowSize
CompressionWindowBits12
Int
13 -> CompressionWindowSize
CompressionWindowBits13
Int
14 -> CompressionWindowSize
CompressionWindowBits14
Int
15 -> CompressionWindowSize
CompressionWindowBits15
Int
16 -> CompressionWindowSize
CompressionWindowBits16
Int
17 -> CompressionWindowSize
CompressionWindowBits17
Int
18 -> CompressionWindowSize
CompressionWindowBits18
Int
19 -> CompressionWindowSize
CompressionWindowBits19
Int
20 -> CompressionWindowSize
CompressionWindowBits20
Int
21 -> CompressionWindowSize
CompressionWindowBits21
Int
22 -> CompressionWindowSize
CompressionWindowBits22
Int
23 -> CompressionWindowSize
CompressionWindowBits23
Int
24 -> CompressionWindowSize
CompressionWindowBits24
Int
_ -> String -> CompressionWindowSize
forall a. HasCallStack => String -> a
error String
"toEnum(CompressionWindowSize): bad argument"
fromEnum :: CompressionWindowSize -> Int
fromEnum CompressionWindowSize
x = case CompressionWindowSize
x of
CompressionWindowSize
CompressionWindowBits10 -> Int
10
CompressionWindowSize
CompressionWindowBits11 -> Int
11
CompressionWindowSize
CompressionWindowBits12 -> Int
12
CompressionWindowSize
CompressionWindowBits13 -> Int
13
CompressionWindowSize
CompressionWindowBits14 -> Int
14
CompressionWindowSize
CompressionWindowBits15 -> Int
15
CompressionWindowSize
CompressionWindowBits16 -> Int
16
CompressionWindowSize
CompressionWindowBits17 -> Int
17
CompressionWindowSize
CompressionWindowBits18 -> Int
18
CompressionWindowSize
CompressionWindowBits19 -> Int
19
CompressionWindowSize
CompressionWindowBits20 -> Int
20
CompressionWindowSize
CompressionWindowBits21 -> Int
21
CompressionWindowSize
CompressionWindowBits22 -> Int
22
CompressionWindowSize
CompressionWindowBits23 -> Int
23
CompressionWindowSize
CompressionWindowBits24 -> Int
24
foreign import capi "hs_brotli.h BrotliEncoderCreateInstance"
c_BrotliEncoderCreateInstance :: Ptr () -> Ptr () -> Ptr () -> IO (Ptr BrotliEncoder)
foreign import capi "hs_brotli.h &BrotliEncoderDestroyInstance"
cp_BrotliEncoderDestroyInstance :: FunPtr (Ptr BrotliEncoder -> IO ())
foreign import capi "hs_brotli.h HsBrotliEncoderCompressStream"
c_BrotliEncoderCompressStream :: Ptr BrotliEncoder
-> Word32
{-# LINE 390 "src/LibBrotli.hsc" #-}
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> IO HsBrotliState
foreign import capi unsafe "hs_brotli.h HsBrotliEncoderTakeOutput"
c_BrotliEncoderTakeOutput :: Ptr BrotliEncoder -> Ptr CSize -> Ptr (Ptr Word8) -> IO HsBrotliState
foreign import capi unsafe "hs_brotli.h BrotliEncoderVersion" brotliEncoderVersion :: Word32
foreign import capi unsafe "hs_brotli.h BrotliEncoderSetParameter"
c_BrotliEncoderSetParameter :: Ptr BrotliEncoder -> Word32 -> Word32 -> IO BrotliBool
{-# LINE 414 "src/LibBrotli.hsc" #-}
foreign import capi "hs_brotli.h BrotliDecoderCreateInstance"
c_BrotliDecoderCreateInstance :: Ptr () -> Ptr () -> Ptr () -> IO (Ptr BrotliDecoder)
foreign import capi "hs_brotli.h &BrotliDecoderDestroyInstance"
cp_BrotliDecoderDestroyInstance :: FunPtr (Ptr BrotliDecoder -> IO ())
foreign import capi "hs_brotli.h HsBrotliDecoderDecompressStream"
c_BrotliDecoderDecompressStream :: Ptr BrotliDecoder
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr CSize
-> IO Word32
{-# LINE 435 "src/LibBrotli.hsc" #-}
foreign import capi unsafe "hs_brotli.h HsBrotliDecoderTakeOutput"
c_BrotliDecoderTakeOutput :: Ptr BrotliDecoder -> Ptr CSize -> Ptr (Ptr Word8) -> IO HsBrotliState
foreign import capi unsafe "hs_brotli.h BrotliDecoderVersion" brotliDecoderVersion :: Word32
foreign import capi unsafe "hs_brotli.h BrotliDecoderSetParameter"
c_BrotliDecoderSetParameter :: Ptr BrotliDecoder -> Word32 -> Word32 -> IO BrotliBool
{-# LINE 450 "src/LibBrotli.hsc" #-}
foreign import capi unsafe "hs_brotli.h BrotliDecoderGetErrorCode"
c_BrotliDecoderGetErrorCode :: Ptr BrotliDecoder -> IO Int32
{-# LINE 453 "src/LibBrotli.hsc" #-}
foreign import capi unsafe "hs_brotli.h HsBrotliDecoderErrorString"
c_BrotliDecoderErrorString :: Int32 -> IO CString
{-# LINE 456 "src/LibBrotli.hsc" #-}