ips/src/IPS/Parse.hs

61 lines
1.5 KiB
Haskell

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)