{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}

module Codec.Compression.Zlib.Adler32 (
  AdlerState,
  initialAdlerState,
  advanceAdler,
  advanceAdlerBlock,
  finalizeAdler,
) where

import Data.Bits (shiftL, (.|.))
import qualified Data.ByteString as S
import GHC.Exts (Word#, plusWord#, remWord#)
import GHC.Word (Word32 (..), Word8 (..))

data AdlerState = AdlerState {AdlerState -> Word#
_adlerA :: Word#, AdlerState -> Word#
_adlerB :: Word#}

initialAdlerState :: AdlerState
initialAdlerState :: AdlerState
initialAdlerState = Word# -> Word# -> AdlerState
AdlerState Word#
1## Word#
0##

advanceAdler :: AdlerState -> Word8 -> AdlerState
advanceAdler :: AdlerState -> Word8 -> AdlerState
advanceAdler (AdlerState Word#
a Word#
b) (W8# Word#
v) = Word# -> Word# -> AdlerState
AdlerState Word#
a' Word#
b'
 where
  a' :: Word#
a' = (Word#
a Word# -> Word# -> Word#
`plusWord#` Word#
v) Word# -> Word# -> Word#
`remWord#` Word#
65521##
  b' :: Word#
b' = (Word#
b Word# -> Word# -> Word#
`plusWord#` Word#
a') Word# -> Word# -> Word#
`remWord#` Word#
65521##
{-# INLINE advanceAdler #-}

advanceNoMod :: AdlerState -> Word8 -> AdlerState
advanceNoMod :: AdlerState -> Word8 -> AdlerState
advanceNoMod (AdlerState Word#
a Word#
b) (W8# Word#
v) = Word# -> Word# -> AdlerState
AdlerState Word#
a' Word#
b'
 where
  a' :: Word#
a' = Word#
a Word# -> Word# -> Word#
`plusWord#` Word#
v
  b' :: Word#
b' = Word#
b Word# -> Word# -> Word#
`plusWord#` Word#
a'
{-# INLINE advanceNoMod #-}

-- The block must be less than 5552 bytes long in this case
advanceAdlerLimited :: AdlerState -> S.ByteString -> AdlerState
advanceAdlerLimited :: AdlerState -> ByteString -> AdlerState
advanceAdlerLimited !AdlerState
state !ByteString
bl = Word# -> Word# -> AdlerState
AdlerState Word#
stateA' Word#
stateB'
 where
  !(AdlerState Word#
stateA Word#
stateB) = (AdlerState -> Word8 -> AdlerState)
-> AdlerState -> ByteString -> AdlerState
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' AdlerState -> Word8 -> AdlerState
advanceNoMod AdlerState
state ByteString
bl
  stateA' :: Word#
stateA' = Word#
stateA Word# -> Word# -> Word#
`remWord#` Word#
65521##
  stateB' :: Word#
stateB' = Word#
stateB Word# -> Word# -> Word#
`remWord#` Word#
65521##

advanceAdlerBlock :: AdlerState -> S.ByteString -> AdlerState
advanceAdlerBlock :: AdlerState -> ByteString -> AdlerState
advanceAdlerBlock !AdlerState
state !ByteString
bl
  | ByteString -> Int
S.length ByteString
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = AdlerState
state
  | ByteString -> Int
S.length ByteString
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = AdlerState -> Word8 -> AdlerState
advanceAdler AdlerState
state (ByteString -> Word8
S.head ByteString
bl)
  | ByteString -> Int
S.length ByteString
bl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5552 = AdlerState -> ByteString -> AdlerState
advanceAdlerLimited AdlerState
state ByteString
bl
  | Bool
otherwise = AdlerState -> ByteString -> AdlerState
advanceAdlerBlock (AdlerState -> ByteString -> AdlerState
advanceAdlerBlock AdlerState
state ByteString
first5551) ByteString
rest
 where
  (!ByteString
first5551, !ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
5551 ByteString
bl

finalizeAdler :: AdlerState -> Word32
finalizeAdler :: AdlerState -> Word32
finalizeAdler (AdlerState Word#
a Word#
b) = Word32
high Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
low
 where
  high :: Word32
high = (Word# -> Word32
W32# Word#
b) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
  low :: Word32
low = Word# -> Word32
W32# Word#
a