ips/src/IPS/Parse.hs

module IPS.Parse (parser, read) where

import Prelude hiding (read)
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.Functor
import qualified Data.Vector.Generic as Vector
import Control.Applicative


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


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

parseBody :: Parser Patch
parseBody = uncurry Vector.fromListN <$> go where
  go = eof <|> chunk
  eof = Parse.string "EOF" $> (0, [])
  chunk = liftA2 cons parseChunk go
    where cons c (!n, cs) = (n + 1, c : cs)

parseChunk :: Parser Chunk
parseChunk = do
  offset <- parseWord24
  size   <- parseWord16
  body   <-
    if size == 0 then
      liftA2 RLE parseWord16 Parse.anyWord8
    else
      Normal . makeBytes <$> Parse.take (fromIntegral size)
  pure $ Chunk {offset, body}

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)