{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Codec.Compression.Zlib.OutputWindow(
         OutputWindow
       , emptyWindow
       , emitExcess
       , finalizeWindow
       , addByte
       , addChunk
       , addOldChunk
       )
 where

import           Data.ByteString.Builder(Builder, toLazyByteString, word8, lazyByteString)
import qualified Data.ByteString      as S
import qualified Data.ByteString.Lazy as L
import           Codec.Compression.Zlib.FingerTree(FingerTree, empty, (|>), dropTakeCombine, split, measure, toBuilder)
import           Data.Int(Int64)
import           Data.Semigroup as Sem
import           Data.Word(Word8)
import           Prelude()
import           Prelude.Compat

type WindowType = FingerTree S.ByteString

data OutputWindow = OutputWindow {
       OutputWindow -> WindowType
owWindow    :: WindowType
     , OutputWindow -> Builder
owRecent    :: Builder
     }

emptyWindow :: OutputWindow
emptyWindow :: OutputWindow
emptyWindow = WindowType -> Builder -> OutputWindow
OutputWindow WindowType
forall a. Measured a => FingerTree a
empty Builder
forall a. Monoid a => a
mempty

emitExcess :: OutputWindow -> Maybe (L.ByteString, OutputWindow)
emitExcess :: OutputWindow -> Maybe (ByteString, OutputWindow)
emitExcess OutputWindow
ow
  | Measure
totalMeasure Measure -> Measure -> Bool
forall a. Ord a => a -> a -> Bool
< Measure
65536 = Maybe (ByteString, OutputWindow)
forall a. Maybe a
Nothing
  | Bool
otherwise            = (ByteString, OutputWindow) -> Maybe (ByteString, OutputWindow)
forall a. a -> Maybe a
Just (ByteString
excess, OutputWindow
ow{ owWindow :: WindowType
owWindow = WindowType
window' })
 where
  window :: WindowType
window              = OutputWindow -> WindowType
owWindow OutputWindow
ow
  totalMeasure :: Measure
totalMeasure        = WindowType -> Measure
forall a. Measured a => a -> Measure
measure WindowType
window
  excessAmount :: Measure
excessAmount        = Measure
totalMeasure Measure -> Measure -> Measure
forall a. Num a => a -> a -> a
- Measure
32768
  (WindowType
excessFT, WindowType
window') = Measure -> WindowType -> (WindowType, WindowType)
forall a.
Measured a =>
Measure -> FingerTree a -> (FingerTree a, FingerTree a)
split Measure
excessAmount WindowType
window
  excess :: ByteString
excess              = Builder -> ByteString
toLazyByteString (WindowType -> Builder
forall a. ToBuilder a => a -> Builder
toBuilder WindowType
excessFT)

finalizeWindow :: OutputWindow -> L.ByteString
finalizeWindow :: OutputWindow -> ByteString
finalizeWindow OutputWindow
ow = Builder -> ByteString
toLazyByteString (WindowType -> Builder
forall a. ToBuilder a => a -> Builder
toBuilder (OutputWindow -> WindowType
owWindow OutputWindow
ow) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OutputWindow -> Builder
owRecent OutputWindow
ow)

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

addByte :: OutputWindow -> Word8 -> OutputWindow
addByte :: OutputWindow -> Word8 -> OutputWindow
addByte !OutputWindow
ow !Word8
b = OutputWindow
ow{ owRecent :: Builder
owRecent = OutputWindow -> Builder
owRecent OutputWindow
ow Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
b }

addChunk :: OutputWindow -> L.ByteString -> OutputWindow
addChunk :: OutputWindow -> ByteString -> OutputWindow
addChunk !OutputWindow
ow !ByteString
bs = OutputWindow
ow{ owRecent :: Builder
owRecent = OutputWindow -> Builder
owRecent OutputWindow
ow Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
bs }

addOldChunk :: OutputWindow -> Int -> Int64 -> (OutputWindow, L.ByteString)
addOldChunk :: OutputWindow -> Measure -> Int64 -> (OutputWindow, ByteString)
addOldChunk !OutputWindow
ow !Measure
dist !Int64
len = (WindowType -> Builder -> OutputWindow
OutputWindow WindowType
output (ByteString -> Builder
lazyByteString ByteString
chunk), ByteString
chunk)
 where
  output :: WindowType
output      = (WindowType -> ByteString -> WindowType)
-> WindowType -> ByteString -> WindowType
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
L.foldlChunks WindowType -> ByteString -> WindowType
forall a. Measured a => FingerTree a -> a -> FingerTree a
(|>) (OutputWindow -> WindowType
owWindow OutputWindow
ow) (Builder -> ByteString
toLazyByteString (OutputWindow -> Builder
owRecent OutputWindow
ow))
  dropAmt :: Measure
dropAmt     = WindowType -> Measure
forall a. Measured a => a -> Measure
measure WindowType
output Measure -> Measure -> Measure
forall a. Num a => a -> a -> a
- Measure
dist
  (WindowType
prev, WindowType
sme) = Measure -> WindowType -> (WindowType, WindowType)
forall a.
Measured a =>
Measure -> FingerTree a -> (FingerTree a, FingerTree a)
split Measure
dropAmt WindowType
output
  chunkBase :: ByteString
chunkBase   = Measure -> Measure -> WindowType -> ByteString
dropTakeCombine (Measure
dropAmt Measure -> Measure -> Measure
forall a. Num a => a -> a -> a
- WindowType -> Measure
forall a. Measured a => a -> Measure
measure WindowType
prev) (Int64 -> Measure
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len) WindowType
sme
  chunkInf :: ByteString
chunkInf    = ByteString
chunkBase ByteString -> ByteString -> ByteString
`L.append` ByteString
chunkInf
  chunk :: ByteString
chunk       = Int64 -> ByteString -> ByteString
L.take Int64
len ByteString
chunkInf