{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
-- | This module implement helper functions to read & write data

-- at bits level.

module Codec.Picture.BitWriter( BoolReader
                              , emptyBoolState
                              , BoolState
                              , byteAlignJpg
                              , getNextBitsLSBFirst
                              , getNextBitsMSBFirst 
                              , getNextBitJpg
                              , getNextIntJpg
                              , setDecodedString
                              , setDecodedStringMSB
                              , setDecodedStringJpg
                              , runBoolReader

                              , BoolWriteStateRef 
                              , newWriteStateRef
                              , finalizeBoolWriter
                              , finalizeBoolWriterGif
                              , writeBits'
                              , writeBitsGif

                              , initBoolState 
                              , initBoolStateJpg
                              , execBoolReader
                              , runBoolReaderWith
                              ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( (<*>), (<$>) )
#endif

import Data.STRef
import Control.Monad( when )
import Control.Monad.ST( ST )
import qualified Control.Monad.Trans.State.Strict as S
import Data.Int ( Int32 )
import Data.Word( Word8, Word32 )
import Data.Bits( (.&.), (.|.), unsafeShiftR, unsafeShiftL )

import Codec.Picture.VectorByteConversion( blitVector )
import qualified Data.Vector.Storable.Mutable as M
import qualified Data.Vector.Storable as VS
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L


--------------------------------------------------

----            Reader

--------------------------------------------------

-- | Current bit index, current value, string

data BoolState = BoolState {-# UNPACK #-} !Int
                           {-# UNPACK #-} !Word8
                           !B.ByteString

emptyBoolState :: BoolState
emptyBoolState :: BoolState
emptyBoolState = Int -> Word8 -> ByteString -> BoolState
BoolState (-Int
1) Word8
0 ByteString
B.empty

-- | Type used to read bits

type BoolReader s a = S.StateT BoolState (ST s) a

runBoolReader :: BoolReader s a -> ST s a
runBoolReader :: forall s a. BoolReader s a -> ST s a
runBoolReader BoolReader s a
action = BoolReader s a -> BoolState -> ST s a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT BoolReader s a
action (BoolState -> ST s a) -> BoolState -> ST s a
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState Int
0 Word8
0 ByteString
B.empty

runBoolReaderWith :: BoolState -> BoolReader s a -> ST s (a, BoolState)
runBoolReaderWith :: forall s a. BoolState -> BoolReader s a -> ST s (a, BoolState)
runBoolReaderWith BoolState
st BoolReader s a
action = BoolReader s a -> BoolState -> ST s (a, BoolState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT BoolReader s a
action BoolState
st

execBoolReader :: BoolState -> BoolReader s a -> ST s BoolState
execBoolReader :: forall s a. BoolState -> BoolReader s a -> ST s BoolState
execBoolReader BoolState
st BoolReader s a
reader = BoolReader s a -> BoolState -> ST s BoolState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
S.execStateT BoolReader s a
reader BoolState
st

initBoolState :: B.ByteString -> BoolState
initBoolState :: ByteString -> BoolState
initBoolState ByteString
str = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
str of
     Maybe (Word8, ByteString)
Nothing -> Int -> Word8 -> ByteString -> BoolState
BoolState Int
0 Word8
0 ByteString
B.empty
     Just (Word8
v, ByteString
rest) -> Int -> Word8 -> ByteString -> BoolState
BoolState Int
0 Word8
v ByteString
rest

initBoolStateJpg :: B.ByteString -> BoolState
initBoolStateJpg :: ByteString -> BoolState
initBoolStateJpg ByteString
str = 
   case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
str of
     Maybe (Word8, ByteString)
Nothing -> Int -> Word8 -> ByteString -> BoolState
BoolState Int
0 Word8
0 ByteString
B.empty
     Just (Word8
0xFF, ByteString
rest) -> case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
rest of
            Maybe (Word8, ByteString)
Nothing                  -> Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
0 ByteString
B.empty
            Just (Word8
0x00, ByteString
afterMarker) -> Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
0xFF ByteString
afterMarker
            Just (Word8
_   , ByteString
afterMarker) -> ByteString -> BoolState
initBoolStateJpg ByteString
afterMarker
     Just (Word8
v, ByteString
rest) -> Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
v ByteString
rest

-- | Bitify a list of things to decode.

setDecodedString :: B.ByteString -> BoolReader s ()
setDecodedString :: forall s. ByteString -> BoolReader s ()
setDecodedString ByteString
str = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
str of
     Maybe (Word8, ByteString)
Nothing        -> BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState      Int
0 Word8
0 ByteString
B.empty
     Just (Word8
v, ByteString
rest) -> BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState      Int
0 Word8
v    ByteString
rest

-- | Drop all bit until the bit of indice 0, usefull to parse restart

-- marker, as they are byte aligned, but Huffman might not.

byteAlignJpg :: BoolReader s ()
byteAlignJpg :: forall s. BoolReader s ()
byteAlignJpg = do
  BoolState Int
idx Word8
_ ByteString
chain <- StateT BoolState (ST s) BoolState
forall (m :: * -> *) s. Monad m => StateT s m s
S.get
  Bool -> BoolReader s () -> BoolReader s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
7) (ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedStringJpg ByteString
chain)

getNextBitJpg :: BoolReader s Bool
{-# INLINE getNextBitJpg #-}
getNextBitJpg :: forall s. BoolReader s Bool
getNextBitJpg = do
    BoolState Int
idx Word8
v ByteString
chain <- StateT BoolState (ST s) BoolState
forall (m :: * -> *) s. Monad m => StateT s m s
S.get
    let val :: Bool
val = (Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. (Word8
1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
idx)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
    if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedStringJpg ByteString
chain
      else BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
v ByteString
chain
    Bool -> BoolReader s Bool
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val

getNextIntJpg :: Int -> BoolReader s Int32
{-# INLINE getNextIntJpg #-}
getNextIntJpg :: forall s. Int -> BoolReader s Int32
getNextIntJpg = Int32 -> Int -> StateT BoolState (ST s) Int32
forall {t} {s}.
(Bits t, Num t) =>
t -> Int -> StateT BoolState (ST s) t
go Int32
0 where
  go :: t -> Int -> StateT BoolState (ST s) t
go !t
acc !Int
0 = t -> StateT BoolState (ST s) t
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return t
acc
  go !t
acc !Int
n = do
    BoolState Int
idx Word8
v ByteString
chain <- StateT BoolState (ST s) BoolState
forall (m :: * -> *) s. Monad m => StateT s m s
S.get
    let !leftBits :: Int
leftBits = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
leftBits then do
      ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedStringJpg ByteString
chain
      let !remaining :: Int
remaining = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBits
          !mask :: t
mask = (t
1 t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
leftBits) t -> t -> t
forall a. Num a => a -> a -> a
- t
1
          !finalV :: t
finalV = Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
mask
          !theseBits :: t
theseBits = t
finalV t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
remaining
      t -> Int -> StateT BoolState (ST s) t
go (t
acc t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
theseBits) Int
remaining
    else do
      let !remaining :: Int
remaining = Int
leftBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
          !mask :: t
mask = (t
1 t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
n) t -> t -> t
forall a. Num a => a -> a -> a
- t
1
          !finalV :: t
finalV = Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
remaining
      BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
v ByteString
chain
      t -> StateT BoolState (ST s) t
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> StateT BoolState (ST s) t) -> t -> StateT BoolState (ST s) t
forall a b. (a -> b) -> a -> b
$ (t
finalV t -> t -> t
forall a. Bits a => a -> a -> a
.&. t
mask) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
acc


setDecodedStringMSB :: B.ByteString -> BoolReader s ()
setDecodedStringMSB :: forall s. ByteString -> BoolReader s ()
setDecodedStringMSB ByteString
str = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
str of
  Maybe (Word8, ByteString)
Nothing        -> BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState      Int
8 Word8
0 ByteString
B.empty
  Just (Word8
v, ByteString
rest) -> BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState      Int
8 Word8
v    ByteString
rest


{-# INLINE getNextBitsMSBFirst #-}
getNextBitsMSBFirst :: Int -> BoolReader s Word32
getNextBitsMSBFirst :: forall s. Int -> BoolReader s Word32
getNextBitsMSBFirst Int
requested = Word32 -> Int -> BoolReader s Word32
forall s. Word32 -> Int -> BoolReader s Word32
go Word32
0 Int
requested where
  go :: Word32 -> Int -> BoolReader s Word32
  go :: forall s. Word32 -> Int -> BoolReader s Word32
go !Word32
acc !Int
0 = Word32 -> StateT BoolState (ST s) Word32
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
acc
  go !Word32
acc !Int
n = do
    BoolState Int
idx Word8
v ByteString
chain <- StateT BoolState (ST s) BoolState
forall (m :: * -> *) s. Monad m => StateT s m s
S.get
    let !leftBits :: Int
leftBits = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
leftBits then do
      ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedStringMSB ByteString
chain
      let !theseBits :: Word32
theseBits = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBits)
      Word32 -> Int -> StateT BoolState (ST s) Word32
forall s. Word32 -> Int -> BoolReader s Word32
go (Word32
acc Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
theseBits) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBits)
    else do
      let !remaining :: Int
remaining = Int
leftBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
          !mask :: Word8
mask = (Word8
1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
remaining) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1
      BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
remaining) (Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask) ByteString
chain
      Word32 -> StateT BoolState (ST s) Word32
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> StateT BoolState (ST s) Word32)
-> Word32 -> StateT BoolState (ST s) Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
remaining) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
acc

{-# INLINE getNextBitsLSBFirst #-}
getNextBitsLSBFirst :: Int -> BoolReader s Word32
getNextBitsLSBFirst :: forall s. Int -> BoolReader s Word32
getNextBitsLSBFirst Int
count = Word32 -> Int -> StateT BoolState (ST s) Word32
forall {t} {s}.
(Bits t, Num t) =>
t -> Int -> StateT BoolState (ST s) t
aux Word32
0 Int
count
  where aux :: t -> Int -> StateT BoolState (ST s) t
aux t
acc Int
0 = t -> StateT BoolState (ST s) t
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return t
acc
        aux t
acc Int
n = do
            Bool
bit <- BoolReader s Bool
forall s. BoolReader s Bool
getNextBit
            let nextVal :: t
nextVal | Bool
bit = t
acc t -> t -> t
forall a. Bits a => a -> a -> a
.|. (t
1 t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))
                        | Bool
otherwise = t
acc
            t -> Int -> StateT BoolState (ST s) t
aux t
nextVal (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

{-# INLINE getNextBit #-}
getNextBit :: BoolReader s Bool
getNextBit :: forall s. BoolReader s Bool
getNextBit = do
    BoolState Int
idx Word8
v ByteString
chain <- StateT BoolState (ST s) BoolState
forall (m :: * -> *) s. Monad m => StateT s m s
S.get
    let val :: Bool
val = (Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. (Word8
1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
idx)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
    if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7
      then ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedString ByteString
chain
      else BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
v ByteString
chain
    Bool -> BoolReader s Bool
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val

-- | Bitify a list of things to decode. Handle Jpeg escape

-- code (0xFF 0x00), thus should be only used in JPEG decoding.

setDecodedStringJpg :: B.ByteString -> BoolReader s ()
setDecodedStringJpg :: forall s. ByteString -> BoolReader s ()
setDecodedStringJpg ByteString
str = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
str of
     Maybe (Word8, ByteString)
Nothing        -> BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
0 ByteString
B.empty
     Just (Word8
0xFF, ByteString
rest) -> case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
rest of
            Maybe (Word8, ByteString)
Nothing                  -> BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
0 ByteString
B.empty
            Just (Word8
0x00, ByteString
afterMarker) -> -- trace "00" $ 

                BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
0xFF ByteString
afterMarker
            Just (Word8
_   , ByteString
afterMarker) -> ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedStringJpg ByteString
afterMarker
     Just (Word8
v, ByteString
rest) ->
        BoolState -> BoolReader s ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put (BoolState -> BoolReader s ()) -> BoolState -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString -> BoolState
BoolState Int
7 Word8
v ByteString
rest

--------------------------------------------------

----            Writer

--------------------------------------------------

defaultBufferSize :: Int
defaultBufferSize :: Int
defaultBufferSize = Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

data BoolWriteStateRef s = BoolWriteStateRef
        { forall s. BoolWriteStateRef s -> STRef s (MVector s Word8)
bwsCurrBuffer   :: STRef s (M.MVector s Word8)
        , forall s. BoolWriteStateRef s -> STRef s [ByteString]
bwsBufferList   :: STRef s [B.ByteString]
        , forall s. BoolWriteStateRef s -> STRef s Int
bwsWrittenWords :: STRef s Int
        , forall s. BoolWriteStateRef s -> STRef s Word8
bwsBitAcc       :: STRef s Word8
        , forall s. BoolWriteStateRef s -> STRef s Int
bwsBitReaded    :: STRef s Int
        }

newWriteStateRef :: ST s (BoolWriteStateRef s)
newWriteStateRef :: forall s. ST s (BoolWriteStateRef s)
newWriteStateRef = do
    MVector s Word8
origMv <- Int -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new Int
defaultBufferSize
    STRef s (MVector s Word8)
-> STRef s [ByteString]
-> STRef s Int
-> STRef s Word8
-> STRef s Int
-> BoolWriteStateRef s
forall s.
STRef s (MVector s Word8)
-> STRef s [ByteString]
-> STRef s Int
-> STRef s Word8
-> STRef s Int
-> BoolWriteStateRef s
BoolWriteStateRef (STRef s (MVector s Word8)
 -> STRef s [ByteString]
 -> STRef s Int
 -> STRef s Word8
 -> STRef s Int
 -> BoolWriteStateRef s)
-> ST s (STRef s (MVector s Word8))
-> ST
     s
     (STRef s [ByteString]
      -> STRef s Int
      -> STRef s Word8
      -> STRef s Int
      -> BoolWriteStateRef s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Word8 -> ST s (STRef s (MVector s Word8))
forall a s. a -> ST s (STRef s a)
newSTRef MVector s Word8
origMv
                      ST
  s
  (STRef s [ByteString]
   -> STRef s Int
   -> STRef s Word8
   -> STRef s Int
   -> BoolWriteStateRef s)
-> ST s (STRef s [ByteString])
-> ST
     s
     (STRef s Int
      -> STRef s Word8 -> STRef s Int -> BoolWriteStateRef s)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ByteString] -> ST s (STRef s [ByteString])
forall a s. a -> ST s (STRef s a)
newSTRef []
                      ST
  s
  (STRef s Int
   -> STRef s Word8 -> STRef s Int -> BoolWriteStateRef s)
-> ST s (STRef s Int)
-> ST s (STRef s Word8 -> STRef s Int -> BoolWriteStateRef s)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
                      ST s (STRef s Word8 -> STRef s Int -> BoolWriteStateRef s)
-> ST s (STRef s Word8)
-> ST s (STRef s Int -> BoolWriteStateRef s)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> ST s (STRef s Word8)
forall a s. a -> ST s (STRef s a)
newSTRef Word8
0
                      ST s (STRef s Int -> BoolWriteStateRef s)
-> ST s (STRef s Int) -> ST s (BoolWriteStateRef s)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0

finalizeBoolWriter :: BoolWriteStateRef s -> ST s L.ByteString
finalizeBoolWriter :: forall s. BoolWriteStateRef s -> ST s ByteString
finalizeBoolWriter BoolWriteStateRef s
st = do
    BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
flushLeftBits' BoolWriteStateRef s
st
    BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
forceBufferFlushing' BoolWriteStateRef s
st
    [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ST s [ByteString] -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s [ByteString] -> ST s [ByteString]
forall s a. STRef s a -> ST s a
readSTRef (BoolWriteStateRef s -> STRef s [ByteString]
forall s. BoolWriteStateRef s -> STRef s [ByteString]
bwsBufferList BoolWriteStateRef s
st)

forceBufferFlushing' :: BoolWriteStateRef s -> ST s ()
forceBufferFlushing' :: forall s. BoolWriteStateRef s -> ST s ()
forceBufferFlushing' (BoolWriteStateRef { bwsCurrBuffer :: forall s. BoolWriteStateRef s -> STRef s (MVector s Word8)
bwsCurrBuffer = STRef s (MVector s Word8)
vecRef
                                        , bwsWrittenWords :: forall s. BoolWriteStateRef s -> STRef s Int
bwsWrittenWords = STRef s Int
countRef
                                        , bwsBufferList :: forall s. BoolWriteStateRef s -> STRef s [ByteString]
bwsBufferList = STRef s [ByteString]
lstRef
                                        }) = do
    MVector s Word8
vec <- STRef s (MVector s Word8) -> ST s (MVector s Word8)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Word8)
vecRef
    Int
count <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
countRef
    [ByteString]
lst <- STRef s [ByteString] -> ST s [ByteString]
forall s a. STRef s a -> ST s a
readSTRef STRef s [ByteString]
lstRef

    MVector s Word8
nmv <- Int -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new Int
defaultBufferSize
    ByteString
str <- MVector s Word8 -> Int -> ST s ByteString
forall s. MVector s Word8 -> Int -> ST s ByteString
byteStringFromVector MVector s Word8
vec Int
count

    STRef s (MVector s Word8) -> MVector s Word8 -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (MVector s Word8)
vecRef MVector s Word8
nmv
    STRef s [ByteString] -> [ByteString] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [ByteString]
lstRef ([ByteString] -> ST s ()) -> [ByteString] -> ST s ()
forall a b. (a -> b) -> a -> b
$ [ByteString]
lst [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
str]
    STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
countRef Int
0

flushCurrentBuffer' :: BoolWriteStateRef s -> ST s ()
flushCurrentBuffer' :: forall s. BoolWriteStateRef s -> ST s ()
flushCurrentBuffer' BoolWriteStateRef s
st = do
    Int
count <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsWrittenWords BoolWriteStateRef s
st
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
defaultBufferSize)
         (BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
forceBufferFlushing' BoolWriteStateRef s
st)

byteStringFromVector :: M.MVector s Word8 -> Int -> ST s B.ByteString
byteStringFromVector :: forall s. MVector s Word8 -> Int -> ST s ByteString
byteStringFromVector MVector s Word8
vec Int
size = do
    Vector Word8
frozen <- MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze MVector s Word8
MVector (PrimState (ST s)) Word8
vec
    ByteString -> ST s ByteString
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ST s ByteString) -> ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> Int -> Int -> ByteString
blitVector Vector Word8
frozen Int
0 Int
size

setBitCount' :: BoolWriteStateRef s -> Word8 -> Int -> ST s ()
{-# INLINE setBitCount' #-}
setBitCount' :: forall s. BoolWriteStateRef s -> Word8 -> Int -> ST s ()
setBitCount' BoolWriteStateRef s
st Word8
acc Int
count = do
    STRef s Word8 -> Word8 -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (BoolWriteStateRef s -> STRef s Word8
forall s. BoolWriteStateRef s -> STRef s Word8
bwsBitAcc BoolWriteStateRef s
st) Word8
acc
    STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsBitReaded BoolWriteStateRef s
st) Int
count

resetBitCount' :: BoolWriteStateRef s -> ST s ()
{-# INLINE resetBitCount' #-}
resetBitCount' :: forall s. BoolWriteStateRef s -> ST s ()
resetBitCount' BoolWriteStateRef s
st = BoolWriteStateRef s -> Word8 -> Int -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> Int -> ST s ()
setBitCount' BoolWriteStateRef s
st Word8
0 Int
0

pushByte' :: BoolWriteStateRef s -> Word8 -> ST s ()
{-# INLINE pushByte' #-}
pushByte' :: forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st Word8
v = do
    BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
flushCurrentBuffer' BoolWriteStateRef s
st
    Int
idx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsWrittenWords BoolWriteStateRef s
st)
    MVector s Word8
vec <- STRef s (MVector s Word8) -> ST s (MVector s Word8)
forall s a. STRef s a -> ST s a
readSTRef (BoolWriteStateRef s -> STRef s (MVector s Word8)
forall s. BoolWriteStateRef s -> STRef s (MVector s Word8)
bwsCurrBuffer BoolWriteStateRef s
st)
    MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.write MVector s Word8
MVector (PrimState (ST s)) Word8
vec Int
idx Word8
v
    STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsWrittenWords BoolWriteStateRef s
st) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

flushLeftBits' :: BoolWriteStateRef s -> ST s ()
flushLeftBits' :: forall s. BoolWriteStateRef s -> ST s ()
flushLeftBits' BoolWriteStateRef s
st = do
    Int
currCount <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsBitReaded BoolWriteStateRef s
st
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
currCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      Word8
currWord <- STRef s Word8 -> ST s Word8
forall s a. STRef s a -> ST s a
readSTRef (STRef s Word8 -> ST s Word8) -> STRef s Word8 -> ST s Word8
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Word8
forall s. BoolWriteStateRef s -> STRef s Word8
bwsBitAcc BoolWriteStateRef s
st
      BoolWriteStateRef s -> Word8 -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st (Word8 -> ST s ()) -> Word8 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word8
currWord Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currCount)

-- | Append some data bits to a Put monad.

writeBits' :: BoolWriteStateRef s
           -> Word32     -- ^ The real data to be stored. Actual data should be in the LSB

           -> Int        -- ^ Number of bit to write from 1 to 32

           -> ST s ()
{-# INLINE writeBits' #-}
writeBits' :: forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
writeBits' BoolWriteStateRef s
st Word32
d Int
c = do
    Word8
currWord <- STRef s Word8 -> ST s Word8
forall s a. STRef s a -> ST s a
readSTRef (STRef s Word8 -> ST s Word8) -> STRef s Word8 -> ST s Word8
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Word8
forall s. BoolWriteStateRef s -> STRef s Word8
bwsBitAcc BoolWriteStateRef s
st
    Int
currCount <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$  BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsBitReaded BoolWriteStateRef s
st
    Word32 -> Int -> Word8 -> Int -> ST s ()
serialize Word32
d Int
c Word8
currWord Int
currCount
  where dumpByte :: Word8 -> ST s ()
dumpByte Word8
0xFF = BoolWriteStateRef s -> Word8 -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st Word8
0xFF ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoolWriteStateRef s -> Word8 -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st Word8
0x00
        dumpByte    Word8
i = BoolWriteStateRef s -> Word8 -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st Word8
i

        serialize :: Word32 -> Int -> Word8 -> Int -> ST s ()
serialize Word32
bitData Int
bitCount Word8
currentWord Int
count
            | Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = do
                     BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
resetBitCount' BoolWriteStateRef s
st
                     Word8 -> ST s ()
dumpByte (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word8
currentWord Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitCount) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|.
                                                Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cleanData)

            | Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 =
                let newVal :: Word8
newVal = Word8
currentWord Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitCount
                in BoolWriteStateRef s -> Word8 -> Int -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> Int -> ST s ()
setBitCount' BoolWriteStateRef s
st (Word8
newVal Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cleanData) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitCount

            | Bool
otherwise =
                let leftBitCount :: Int
leftBitCount = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count :: Int
                    highPart :: Word32
highPart = Word32
cleanData Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBitCount) :: Word32
                    prevPart :: Word32
prevPart = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
currentWord Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
leftBitCount :: Word32

                    nextMask :: Word32
nextMask = (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBitCount)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1 :: Word32
                    newData :: Word32
newData = Word32
cleanData Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
nextMask :: Word32
                    newCount :: Int
newCount = Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBitCount :: Int

                    toWrite :: Word8
toWrite = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
prevPart Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
highPart :: Word8
                in Word8 -> ST s ()
dumpByte Word8
toWrite ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Int -> Word8 -> Int -> ST s ()
serialize Word32
newData Int
newCount Word8
0 Int
0

              where cleanMask :: Word32
cleanMask = (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitCount) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1 :: Word32
                    cleanData :: Word32
cleanData = Word32
bitData Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
cleanMask     :: Word32

-- | Append some data bits to a Put monad.

writeBitsGif :: BoolWriteStateRef s
             -> Word32     -- ^ The real data to be stored. Actual data should be in the LSB

             -> Int        -- ^ Number of bit to write from 1 to 32

             -> ST s ()
{-# INLINE writeBitsGif #-}
writeBitsGif :: forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
writeBitsGif BoolWriteStateRef s
st Word32
d Int
c = do
    Word8
currWord <- STRef s Word8 -> ST s Word8
forall s a. STRef s a -> ST s a
readSTRef (STRef s Word8 -> ST s Word8) -> STRef s Word8 -> ST s Word8
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Word8
forall s. BoolWriteStateRef s -> STRef s Word8
bwsBitAcc BoolWriteStateRef s
st
    Int
currCount <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$  BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsBitReaded BoolWriteStateRef s
st
    Word32 -> Int -> Word8 -> Int -> ST s ()
serialize Word32
d Int
c Word8
currWord Int
currCount
  where dumpByte :: Word8 -> ST s ()
dumpByte = BoolWriteStateRef s -> Word8 -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st

        serialize :: Word32 -> Int -> Word8 -> Int -> ST s ()
serialize Word32
bitData Int
bitCount Word8
currentWord Int
count
            | Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = do
                     BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
resetBitCount' BoolWriteStateRef s
st
                     Word8 -> ST s ()
dumpByte (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8
currentWord  Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|.
                                                (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cleanData Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
count))

            | Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 =
                let newVal :: Word8
newVal = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cleanData Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
count
                in BoolWriteStateRef s -> Word8 -> Int -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> Int -> ST s ()
setBitCount' BoolWriteStateRef s
st (Word8
newVal Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
currentWord) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitCount

            | Bool
otherwise =
                let leftBitCount :: Int
leftBitCount = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count :: Int
                    newData :: Word32
newData = Word32
cleanData Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
leftBitCount :: Word32
                    newCount :: Int
newCount = Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftBitCount :: Int
                    toWrite :: Word8
toWrite = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
currentWord 
                                            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
cleanData Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
count) :: Word8
                in Word8 -> ST s ()
dumpByte Word8
toWrite ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Int -> Word8 -> Int -> ST s ()
serialize Word32
newData Int
newCount Word8
0 Int
0

              where cleanMask :: Word32
cleanMask = (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitCount) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1 :: Word32
                    cleanData :: Word32
cleanData = Word32
bitData Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
cleanMask     :: Word32

finalizeBoolWriterGif :: BoolWriteStateRef s -> ST s L.ByteString
finalizeBoolWriterGif :: forall s. BoolWriteStateRef s -> ST s ByteString
finalizeBoolWriterGif BoolWriteStateRef s
st = do
    BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
flushLeftBitsGif BoolWriteStateRef s
st
    BoolWriteStateRef s -> ST s ()
forall s. BoolWriteStateRef s -> ST s ()
forceBufferFlushing' BoolWriteStateRef s
st
    [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ST s [ByteString] -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s [ByteString] -> ST s [ByteString]
forall s a. STRef s a -> ST s a
readSTRef (BoolWriteStateRef s -> STRef s [ByteString]
forall s. BoolWriteStateRef s -> STRef s [ByteString]
bwsBufferList BoolWriteStateRef s
st)

flushLeftBitsGif :: BoolWriteStateRef s -> ST s ()
flushLeftBitsGif :: forall s. BoolWriteStateRef s -> ST s ()
flushLeftBitsGif BoolWriteStateRef s
st = do
    Int
currCount <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Int
forall s. BoolWriteStateRef s -> STRef s Int
bwsBitReaded BoolWriteStateRef s
st
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
currCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      Word8
currWord <- STRef s Word8 -> ST s Word8
forall s a. STRef s a -> ST s a
readSTRef (STRef s Word8 -> ST s Word8) -> STRef s Word8 -> ST s Word8
forall a b. (a -> b) -> a -> b
$ BoolWriteStateRef s -> STRef s Word8
forall s. BoolWriteStateRef s -> STRef s Word8
bwsBitAcc BoolWriteStateRef s
st
      BoolWriteStateRef s -> Word8 -> ST s ()
forall s. BoolWriteStateRef s -> Word8 -> ST s ()
pushByte' BoolWriteStateRef s
st Word8
currWord

{-# ANN module "HLint: ignore Reduce duplication" #-}