parsing - 在Haskell中严格使用Binary解码文件时出现问题

Question

我正在尝试严格地读取和解码二进制文件，这似乎在大多数时间都有效。但不幸的是，在某些情况下，我的程序因

“字节太少。在字节位置1读取失败”

我猜Binary的解码功能认为没有可用数据，
但我知道有，只要重新运行该程序就可以了。

我已经尝试了几种解决方案，但都无法解决我的问题:(

使用withBinaryFile的

:

decodeFile' path = withBinaryFile path ReadMode doDecode
  where
    doDecode h = do c <- LBS.hGetContents h
                    return $! decode c

使用严格的ByteString读取整个​​文件并从中解码:

decodeFile' path = decode . LBS.fromChunks . return <$> BS.readFile path

增加了一些严格性

decodeFile' path = fmap (decode . LBS.fromChunks . return) $! BS.readFile path

任何想法在这里发生了什么以及如何解决该问题？

谢谢!

编辑:我想我已经解决了我的问题。这与严格读取文件无关。我有许多进程主要是从文件中读取的，但是有时需要写入该文件，这将首先截断该文件，然后添加新内容。因此，为了进行编写，我需要首先设置文件锁定，当使用“Binary.encodeFile”时，这似乎并没有完成(当我说进程不是线程，而是运行同一程序的实际实例时)。

编辑最后，我花了一些时间使用POSIX IO和文件锁来解决我的问题。从那以后我再也没有问题了。

万一有人对我当前的解决方案感兴趣，或者有人可以指出错误/问题，我将在这里发布我的解决方案。

安全编码到文件:

safeEncodeFile path value = do
    fd <- openFd path WriteOnly (Just 0o600) (defaultFileFlags {trunc = True})
    waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0)
    let cs = encode value
    let outFn = LBS.foldrChunks (\c rest -> writeChunk fd c >> rest) (return ()) cs
    outFn
    closeFd fd
  where
    writeChunk fd bs = unsafeUseAsCString bs $ \ptr ->
                         fdWriteBuf fd (castPtr ptr) (fromIntegral $ BS.length bs)

和解码文件:

safeDecodeFile def path = do
    e <- doesFileExist path
    if e
      then do fd <- openFd path ReadOnly Nothing
                           (defaultFileFlags{nonBlock=True})
              waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0)
              c  <- fdGetContents fd
              let !v = decode $! c
              return v
      else return def

fdGetContents fd = lazyRead
  where
    lazyRead = unsafeInterleaveIO loop

    loop = do blk <- readBlock fd
              case blk of
                Nothing -> return LBS.Empty
                Just c  -> do cs <- lazyRead
                              return (LBS.Chunk c cs)

readBlock fd = do buf <- mallocBytes 4096
                  readSize <- fdReadBuf fd buf 4096
                  if readSize == 0
                    then do free buf
                            closeFd fd
                            return Nothing
                    else do bs <- unsafePackCStringFinalizer buf
                                         (fromIntegral readSize)
                                         (free buf)
                            return $ Just bs

对于严格和惰性的Bytestring具有合格的导入为:

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Internal as LBS

Answer 1

如果您可以生成一些运行并演示该问题的最小代码段，将很有帮助。现在，我不确信这不是您的程序跟踪哪个句柄被打开/关闭以及读/写互相妨碍的问题。这是我制作的可以正常运行的示例测试代码。

import Data.Trie as T
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Binary
import System.IO

tmp = "blah"

main = do
    let trie = T.fromList    [(B.pack [p], p) | p <- [0..]]
    (file,hdl) <- openTempFile "/tmp" tmp
    B.hPutStr hdl (B.concat $ L.toChunks $ encode trie)
    hClose hdl
    putStrLn file
    t <- B.readFile file
    let trie' = decode (L.fromChunks [t])
    print (trie' == trie)