module LZ77 where

import BitHelper
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as L
import qualified Data.Word as W

-- The result is either a (length, distance) pair
-- or 8-bit characters representing the string value
type Result = (Int, Int, W.Word8)
type MResult = Maybe Result

-- minimum matching length as described in RFC 1951.
minMatchLength :: Int
minMatchLength = 3

windowLength :: Int
windowLength = 10000

getFileContent :: String -> IO LBS.ByteString 
getFileContent  = LBS.readFile 

{-
do lz77 compression
-}
lz77Compress :: LBS.ByteString -> [MResult]
lz77Compress content = doLZ77 [] (LBS.unpack content)

doLZ77 :: [W.Word8] -> [W.Word8] -> [MResult]
doLZ77 buffer str
  | null str = [Nothing]
  | otherwise = Just res : doLZ77 newBuffer newStr
  where
    res@(l, d, c) = search buffer str
    matchLen = if l == 0 then 1 else l
    (matched, newStr) = splitAt matchLen str
    tempBuffer = buffer ++ matched
    newBuffer = drop (max 0 (length tempBuffer - windowLength)) tempBuffer

search :: [W.Word8] -> [W.Word8] -> (Int, Int, W.Word8)
search buffer str
  | null str = error "this shouldn't happen"
  | null buffer = (0, 0, fromIntegral $ head str)
  | otherwise = (len, dist, fromIntegral nextChar)
  where
    searchStr = take 258 str
    (len, dist) = findBuf buffer searchStr
    nextChar = head str

{-
Given a buffer and a needle, return the (length,distance) pair
returns the longest input that begins in the buffer

Length has to be a minimum of 3 characters following DEFLATE convention
-}
findBuf :: [W.Word8] -> [W.Word8] -> (Int, Int)
findBuf buffer str
  | null buffer || null str = (0, 0)
  | otherwise = comPair (len, dist) temp
  where
    mLen = prefixMatch buffer str
    len = if mLen >= minMatchLength then mLen else 0
    dist = if len > 0 then length buffer else 0
    temp = findBuf (drop 1 buffer) str

prefixMatch :: [W.Word8] -> [W.Word8] -> Int 
prefixMatch [] _ = 0
prefixMatch _ [] = 0
prefixMatch (x:xs) (y:ys) 
  | x == y = 1 + prefixMatch xs ys
  | otherwise = 0

{-
Compares two (len,dist) pairs and returns the more optimal pair.
-}
comPair :: (Int, Int) -> (Int, Int) -> (Int, Int)
comPair (llen, ldist) (rlen, rdist)
  | llen > rlen = (llen, ldist)
  | llen == rlen = if ldist < rdist then (llen, ldist) else (rlen, rdist)
  | otherwise = (rlen, rdist)