encodeTokenHeader :: Buffer
                  -> BufferSize
                  -> EncodeStrategy
                  -> Bool -- ^ 'True' at the first time, 'False' when continued.
                  -> DynamicTable
                  -> TokenHeaderList
                  -> IO (TokenHeaderList, Int) -- ^ Leftover, filled length
encodeTokenHeader buf siz EncodeStrategy{..} first dyntbl hs0 = do
    wbuf <- newWriteBuffer buf siz
    when first $ changeTableSize dyntbl wbuf
    let fa = indexedHeaderField dyntbl wbuf useHuffman
        fb = literalHeaderFieldWithIncrementalIndexingIndexedName dyntbl wbuf useHuffman
        fc = literalHeaderFieldWithIncrementalIndexingNewName dyntbl wbuf useHuffman
        fd = literalHeaderFieldWithoutIndexingIndexedName dyntbl wbuf useHuffman
        fe = literalHeaderFieldWithoutIndexingNewName dyntbl wbuf useHuffman
        fe' = literalHeaderFieldWithoutIndexingNewName' dyntbl wbuf useHuffman
        rev = getRevIndex dyntbl
        step0 = case compressionAlgo of
            Naive  -> naiveStep  fe'
            Static -> staticStep fa fd fe
            Linear -> linearStep rev fa fb fc fd
    ref1 <- currentOffset wbuf >>= newIORef
    ref2 <- newIORef hs0
    loop wbuf ref1 ref2 step0 hs0 `E.catch` \BufferOverrun -> return ()
    end <- readIORef ref1
    let len = end `minusPtr` buf
    hs <- readIORef ref2
    return (hs, len)
  where
    loop wbuf ref1 ref2 step hsx = go hsx
      where
        go [] = return ()
        go ((t,v):hs) = do
            _ <- step t v
            currentOffset wbuf >>= writeIORef ref1
            writeIORef ref2 hs
            go hs

----------------------------------------------------------------
encodeTokenHeader :: Buffer
                  -> BufferSize
                  -> EncodeStrategy
                  -> Bool -- ^ 'True' at the first time, 'False' when continued.
                  -> DynamicTable
                  -> TokenHeaderList
                  -> IO (TokenHeaderList, Int)
encodeTokenHeader buf siz EncodeStrategy{..} first dyntbl hs0 = do
    wbuf <- newWriteBuffer buf siz
    when first $ changeTableSize dyntbl wbuf
    let fa = indexedHeaderField dyntbl wbuf useHuffman
        fb = literalHeaderFieldWithIncrementalIndexingIndexedName dyntbl wbuf useHuffman
        fc = literalHeaderFieldWithIncrementalIndexingNewName dyntbl wbuf useHuffman
        fd = literalHeaderFieldWithoutIndexingIndexedName dyntbl wbuf useHuffman
        fe = literalHeaderFieldWithoutIndexingNewName dyntbl wbuf useHuffman
        fe' = literalHeaderFieldWithoutIndexingNewName' dyntbl wbuf useHuffman
        rev = getRevIndex dyntbl
        step0 = case compressionAlgo of
            Naive  -> naiveStep  fe'
            Static -> staticStep fa fd fe
            Linear -> linearStep rev fa fb fc fd
    ref1 <- currentOffset wbuf >>= newIORef
    ref2 <- newIORef hs0
    loop wbuf ref1 ref2 step0 hs0 `E.catch` \BufferOverrun -> return ()
    end <- readIORef ref1
    let len = end `minusPtr` buf
    hs <- readIORef ref2
    return (hs, len)
  where
    loop wbuf ref1 ref2 step hsx = go hsx
      where
        go [] = return ()
        go ((t,v):hs) = do
            _ <- step t v
            currentOffset wbuf >>= writeIORef ref1
            writeIORef ref2 hs
            go hs

----------------------------------------------------------------
encodeTokenHeader buf siz EncodeStrategy{..} first dyntbl hs0 = do
    wbuf <- newWriteBuffer buf siz
    when first $ changeTableSize dyntbl wbuf
    let fa = indexedHeaderField dyntbl wbuf useHuffman
        fb = literalHeaderFieldWithIncrementalIndexingIndexedName dyntbl wbuf useHuffman
        fc = literalHeaderFieldWithIncrementalIndexingNewName dyntbl wbuf useHuffman
        fd = literalHeaderFieldWithoutIndexingIndexedName dyntbl wbuf useHuffman
        fe = literalHeaderFieldWithoutIndexingNewName dyntbl wbuf useHuffman
        fe' = literalHeaderFieldWithoutIndexingNewName' dyntbl wbuf useHuffman
        rev = getRevIndex dyntbl
        step0 = case compressionAlgo of
            Naive  -> naiveStep  fe'
            Static -> staticStep fa fd fe
            Linear -> linearStep rev fa fb fc fd
    ref1 <- currentOffset wbuf >>= newIORef
    ref2 <- newIORef hs0
    loop wbuf ref1 ref2 step0 hs0 `E.catch` \BufferOverrun -> return ()
    end <- readIORef ref1
    let len = end `minusPtr` buf
    hs <- readIORef ref2
    return (hs, len)
  where
    loop wbuf ref1 ref2 step hsx = go hsx
      where
        go [] = return ()
        go ((t,v):hs) = do
            _ <- step t v
            currentOffset wbuf >>= writeIORef ref1
            writeIORef ref2 hs
            go hs

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