Haskell: как распарсить простейший бинарный файл?

[yoshakar]

Есть бинарный файл простейшего формата, который надо распарсить с помощью Haskell. Я пробовал использовать Attoparsec, Data.Binary.Get и другие альтернативы, но так и не могу понять как же это сделать. Формат такой:
'A' SIZE STRING_1_1 0 STRING_1_2 0 ... STRING_1_N1 0
'B' SIZE N2 STRING_2_1 0 STRING_2_2 0 ... STRING_2_N2 0
...
То есть файл состоит из последовательности блоков, блок начинается с сигнатуры типа блока - A или B. Дальше идёт размер остатка блока в байтах.

Если это блок A, то дальше просто идёт список нуль-терминированных строк, причём количество их неизвестно - здесь надо ориентироваться на длину блока. Естественно, если последний байт в блоке не нулевой, надо здесь же выдать ошибку, не вылезая за границу блока.

Если это блок B, то всё то же самое, но ещё в начале блока указано количество строк. В этом случае надо и не залезть за границу блока и не читать больше строк, чем указано, И, естественно, надо вернуть ошибку, если количество строк оказалось неверным либо в конце не оказалось нуля.

Само собой разумеется, что читать целиком блок в (не-lazy) BinaryString и затем его парсить нельзя.

С помощью Data.Binary.Get такую штуку вроде бы получается распарсить, но ключевая функция isolate вызывает error и соответственно аварийный вылет программы, если был прочитан не весь блок (что например бывает если в блоке типа B указано неверное количество строк - меньше чем на самом деле в блоке).

Я знаю, что на форуме есть спецы по хаскелл. Неужели не существует библиотеки, способной парсить такой простой формат?

[Stauffenberg]

Вы хотите, чтобы за Вас код с нуля написали, чтобы он корректно работал с вашим файлом, или у Вас ошибка какая-то, которую Вы не понимаете?

Я пробовал использовать Attoparsec, Data.Binary.Get и другие альтернативы

Не Data.Binary.Get, а Data.ByteString. Про ByteString читать вот тут.

Вот это у Вас получается? Там Data.ByteString.Lazy.

[yoshakar]

Вы хотите, чтобы за Вас код с нуля написали, чтобы он корректно работал с вашим файлом?

Я хочу понять - неужели комбинируя существующие библиотеки нельзя выполнить мою задачу? Если нельзя, я напишу свой парсер. Но не хотелось бы делать это без причины.

https://wiki.haskell.org/Dealing_with_binary_data

С этого я как раз начал. Там как раз используется монада Get из Data.Binary. Раз вы меня тыкаете в это, то у меня вопрос: если я позову runGet (getLazyByteString 100), это вызовет или не вызовет немедленное чтение сотни байт из файла в память?

[Stauffenberg]

Вы хотите, чтобы за Вас код с нуля написали, чтобы он корректно работал с вашим файлом?

Я хочу понять - неужели комбинируя существующие библиотеки нельзя выполнить мою задачу?

Можно конечно. Давайте так: покажите код, который не работает. И прикрепите куда-нибудь файлик, с которым Вы работаете.

Раз вы меня тыкаете в это

Я Вас никуда не тыкаю, я хочу понять в чем именно проблема.

[yoshakar]

Ок. Только это не упрощённая версия из стартового поста, а действительно файл и код с которыми я работаю.

Код: Выделить всё

import Tes3
import System.IO
import qualified Data.ByteString.Lazy as B
import Data.Binary.Get
import Control.Monad.Trans.Either
import Control.Monad.Loops
import Control.Monad
import Control.Applicative

testFiles =
  [ "005"
  , "005i"
  ]

readTestFile :: Handle -> IO ()
readTestFile handle = do
  stream <- B.hGetContents handle
  print . show $ runGet (runEitherT getTes3File) stream

main :: IO ()
main = do
  void $ mapM (\test_file -> withBinaryFile test_file ReadMode readTestFile) testFiles

Код: Выделить всё

module Tes3 where

import Data.Word
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.ByteString.Lazy as B
import Data.Binary.Get
import Data.Binary.Put
import Data.HList
import Data.HList.HListPrelude
import Data.Dynamic
import Control.Applicative
import Control.Monad.Trans.Either
import Control.Monad.Loops

data Sticker
  = TES3 | HEDR | MAST | DATA | GLOB | NAME | FNAM | FORM
  | GMST | GMDT | ACTI | ALCH | APPA | ARMO | BODY | BOOK
  | BSGN | CELL | CLAS | CLOT | CNTC | CONT | CREA | CREC
  | DIAL | DOOR | ENCH | FACT | INFO | INGR | LAND | LEVC
  | LEVI | LIGH | LOCK | LTEX | MGEF | MISC | NPC_ | NPCC
  | PGRD | PROB | RACE | REGN | REPA | SCPT | SKIL | SNDG
  | SOUN | SPEL | SSCR | STAT | WEAP | SAVE | JOUR | QUES
  | GSCR | PLAY | CSTA | GMAP | DIAS | WTHR | KEYS | DYNA
  | ASPL | ACTC | MPRJ | PROJ | DCOU | MARK | FILT | DBGP
  | STRV | INTV | FLTV | SCHD | SCVR | SCDT | SCTX | MODL
  | IRDT | SCRI | ITEX | CNDT | FLAG | MCDT | NPCO | AADT
  deriving (Eq, Show, Read, Enum)

stickerValue :: Sticker -> Word32
stickerValue s =
  runGet getWord32le $ C.pack $ show s

stickerScan :: Word32 -> Sticker
stickerScan w =
  read $ C.unpack $ runPut $ putWord32le w

data T3FileSignature = ESP | ESM | ESS deriving (Eq, Show, Enum)

fileSignatureValue :: T3FileSignature -> Word32
fileSignatureValue ESP = 0
fileSignatureValue ESM = 1
fileSignatureValue ESS = 32

fileSignatureScan :: Word32 -> T3FileSignature
fileSignatureScan 0 = ESP
fileSignatureScan 1 = ESM
fileSignatureScan 32 = ESS
fileSignatureScan _ = error "Unknown signature"

getSticker :: Get Sticker
getSticker = stickerScan <$> getWord32le

type T3Error = String
type T3Get d = EitherT T3Error Get d

t3Right :: Get d -> T3Get d
t3Right p = EitherT $ Right <$> p

t3Assert :: Eq s => s -> s -> d -> Either T3Error d
t3Assert expected actual t
  | expected == actual = Right t
  | otherwise = Left "Unexpected data"

data T3Record d = T3Record Sticker d deriving Show

getRecordPC :: T3Get () -> (Word32 -> T3Get d) -> T3Get (T3Record d)
getRecordPC padding reader = do
  sticker <- t3Right getSticker
  size <- t3Right getWord32le
  padding
  t <- EitherT $ isolate (fromIntegral size) $ runEitherT (reader size)
  return $ T3Record sticker t

getRecordNC :: Int -> (Word32 -> T3Get d) -> T3Get (T3Record d)
getRecordNC padding_size reader = getRecordPC (t3Right (skip padding_size)) reader

getRecordNG :: Int -> T3Get d -> T3Get (T3Record d)
getRecordNG padding_size reader = getRecordNC padding_size (\_ -> reader)

getRecordNSG :: Int -> Sticker -> T3Get d -> T3Get (T3Record d)
getRecordNSG padding_size sticker reader = do
  (T3Record s d) <- getRecordNG padding_size reader
  hoistEither $ t3Assert sticker s (T3Record s d)

getMasterRefRecord = do
  T3Record _ name <- getRecordNSG 0 MAST $ t3Right $ C.unpack <$> getLazyByteStringNul
  T3Record _ size <- getRecordNSG 0 DATA $ t3Right getWord64le
  return (name, size)

getFileHeader = do
  version <- getWord32le
  signature <- fileSignatureScan <$> getWord32le
  author <- takeWhile ((/=) '\0') . C.unpack <$> getLazyByteString 32
  description <- takeWhile ((/=) '\0') . C.unpack <$> getLazyByteString 256
  items_count <- getWord32le
  return ((version, signature, author, description), items_count)

getTes3Record = do
  T3Record _ (header, items_count) <- getRecordNSG 0 HEDR $ t3Right getFileHeader
  refs <- whileM (t3Right $ not <$> isEmpty) getMasterRefRecord
  return (header, items_count, refs)

getTes3File = do
  T3Record _ (header, items_count, refs) <- getRecordNSG 8 TES3 getTes3Record
  return (header, items_count, refs)

Файлики 005 и 005i.
Первый файл валидный и он парсится нормально.
Провблема со вторым - невалидным файлом. Вместо Left "Unexpected data" я получаю что невразумительное: Prelude.read: no parse

[yoshakar]

Я кажется нашёл в чём моя ошибка: нужно во-первых использовать runGetOrFail вместо runGet, а во-вторых вместо самопально впихнутого Either тоже звать fail. Тогда isolate не будет проводить проверку, а просто будет возвращать внутренний fail как он есть, и fail будет превращаться в сообщение о ошибке а не в error.

[yoshakar]

Да, это работает. Всё дело было в том, что я не понимал что такое fail и зачем оно нужно. Stauffenberg, спасибо за помощь.