在 Haskell 中使用二进制严格解码文件的问题

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

对于严格和惰性字节字符串的合格导入为：

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

Answer 1

如果您可以生成一些运行并演示问题的最小代码 sn-p，那将会很有帮助。现在我不相信这不是你的程序跟踪打开/关闭句柄和读/写相互妨碍的问题。这是我制作的示例测试代码，效果很好。

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)