|
|
@ -5,7 +5,6 @@ import IPS.Types
|
|
|
|
import Data.Attoparsec.ByteString (Parser)
|
|
|
|
import Data.Attoparsec.ByteString (Parser)
|
|
|
|
import qualified Data.Attoparsec.ByteString as Parse
|
|
|
|
import qualified Data.Attoparsec.ByteString as Parse
|
|
|
|
import Data.Bits
|
|
|
|
import Data.Bits
|
|
|
|
import Data.Bifunctor
|
|
|
|
|
|
|
|
import qualified Data.ByteString as ByteString
|
|
|
|
import qualified Data.ByteString as ByteString
|
|
|
|
import Data.Functor
|
|
|
|
import Data.Functor
|
|
|
|
import qualified Data.Vector.Generic as Vector
|
|
|
|
import qualified Data.Vector.Generic as Vector
|
|
|
@ -24,17 +23,17 @@ parseBody = uncurry Vector.fromListN <$> go where
|
|
|
|
go = eof <|> chunk
|
|
|
|
go = eof <|> chunk
|
|
|
|
eof = Parse.string "EOF" $> (0, [])
|
|
|
|
eof = Parse.string "EOF" $> (0, [])
|
|
|
|
chunk = liftA2 cons parseChunk go
|
|
|
|
chunk = liftA2 cons parseChunk go
|
|
|
|
where cons c = bimap (+ 1) (c :)
|
|
|
|
where cons c (!n, cs) = (n + 1, c : cs)
|
|
|
|
|
|
|
|
|
|
|
|
parseChunk :: Parser Chunk
|
|
|
|
parseChunk :: Parser Chunk
|
|
|
|
parseChunk = do
|
|
|
|
parseChunk = do
|
|
|
|
offset <- parseWord24
|
|
|
|
offset <- parseWord24
|
|
|
|
size₀ <- parseWord16
|
|
|
|
size <- parseWord16
|
|
|
|
body <-
|
|
|
|
body <-
|
|
|
|
if size₀ == 0 then
|
|
|
|
if size == 0 then
|
|
|
|
liftA2 RLE parseWord16 Parse.anyWord8
|
|
|
|
liftA2 RLE parseWord16 Parse.anyWord8
|
|
|
|
else
|
|
|
|
else
|
|
|
|
Normal . makeBytes <$> Parse.take (fromIntegral size₀)
|
|
|
|
Normal . makeBytes <$> Parse.take (fromIntegral size)
|
|
|
|
pure $ Chunk {offset, body}
|
|
|
|
pure $ Chunk {offset, body}
|
|
|
|
|
|
|
|
|
|
|
|
parseWord16 :: Parser Word16
|
|
|
|
parseWord16 :: Parser Word16
|
|
|
@ -45,7 +44,7 @@ parseWord24 = parseWordBE 3
|
|
|
|
|
|
|
|
|
|
|
|
parseWordBE :: (Integral a, Bits a) => Word -> Parser a
|
|
|
|
parseWordBE :: (Integral a, Bits a) => Word -> Parser a
|
|
|
|
parseWordBE = go 0 where
|
|
|
|
parseWordBE = go 0 where
|
|
|
|
go acc 0 = pure acc
|
|
|
|
go !acc 0 = pure acc
|
|
|
|
go acc i = do
|
|
|
|
go !acc i = do
|
|
|
|
b <- fromIntegral <$> Parse.anyWord8
|
|
|
|
b <- fromIntegral <$> Parse.anyWord8
|
|
|
|
go ((acc `shiftL` 8) .|. b) (i - 1)
|
|
|
|
go ((acc `shiftL` 8) .|. b) (i - 1)
|
|
|
|