ips/src/IPS/Parse.hs

module IPS.Parse (parser, parseFile) where

import IPS.Types
import Data.Attoparsec.ByteString (Parser)
import qualified Data.Attoparsec.ByteString as Parse
import Data.Bits
import qualified Data.ByteString as ByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Control.Applicative


parseFile :: FilePath -> IO (Either String Patch)
parseFile f = Parse.parseOnly parser <$> ByteString.readFile f


parser :: Parser Patch
parser = Parse.string "PATCH" *> parseRest


parseRest :: Parser Patch
parseRest = make <$> go where
  go    = eof <|> chunk
  eof   = Rest 0 [] <$ Parse.string "EOF"
  chunk = cons <$> parseChunk <*> go

data Rest = Rest {len :: {-# UNPACK #-} !Int, chunks :: [Chunk]}

cons :: Chunk -> Rest -> Rest
cons c (Rest {len, chunks}) = Rest {len = succ len, chunks = c : chunks}

make :: Rest -> Vector Chunk
make (Rest n cs) = Vector.fromListN n cs


parseChunk :: Parser Chunk
parseChunk = do
  offset <- parseWord24
  size   <- parseWord16
  body   <- parseBody size
  pure $ Chunk {offset, body}


parseBody :: Word16 -> Parser ChunkBody
parseBody 0 = RLE <$> parseWord16 <*> Parse.anyWord8
parseBody n = Normal . makeBytes <$> Parse.take (fromIntegral n)


parseWord16 :: Parser Word16
parseWord16 = parseWordBE 2

parseWord24 :: Parser Word24
parseWord24 = parseWordBE 3

parseWordBE :: (Integral a, Bits a) => Word -> Parser a
parseWordBE = go 0 where
  go !acc 0 = pure acc
  go !acc i = do
    b <- fromIntegral <$> Parse.anyWord8
    go ((acc `shiftL` 8) .|. b) (i - 1)