Haskell: прочитайте двоичный файл назад

Question

Я ищу, чтобы найти последнее 32-битное слово в двоичном дамбе uInt32, соответствующем определенному шаблону с использованием Haskell. Я могу выполнить задачу, используя last, однако код должен пройти через весь файл, чтобы он был довольно неэффективным.

Есть ли простой способ сделать readfile работать через файл в обратном направлении? Я считаю, что это решит проблему с наименьшим изменением текущего кода.

Вот мой текущий код, для справки. Я только начал с Haskell в эти выходные, поэтому я уверен, что это довольно уродливо. Он ищет последнее 32-битное слово, начинающееся с 0b10 в MSB.

import System.Environment(getArgs) 
import qualified Data.ByteString.Lazy as BL 
import qualified Data.ByteString.Lazy.Internal as BL 
import qualified Data.ByteString as BS 
import Data.Binary.Get 
import Data.Word 
import Data.Bits 
import Text.Printf(printf) 

main = do 
    args <- getArgs 
    let file = args!!0 
    putStrLn $ "Find last 0xCXXXXXXX in " ++ file 

    content <- BL.readFile file 

    let packets = getPackets content 
    putStrLn . show . getValue . last . filterTimes $ packets 

-- Data 

type Packet = Word32 

-- filter where first 2 bits are 10 
filterTimes :: [Packet] -> [Packet] 
filterTimes = filter ((== 0x2) . tag) 

-- get the first 2 bits 
tag :: Packet -> Packet 
tag rp = 
    let tagSize = 2 
    in shiftR rp (finiteBitSize rp - tagSize) 

-- remove the tag bits 
getValue :: Packet -> Packet 
getValue = 
    let tagSize = 2 
     mask = complement $ rotateR (2^tagSize - 1) tagSize 
    in (.&.) mask 

-- Input 
-- Based on https://hackage.haskell.org/package/binary/docs/Data-Binary-Get.html 

getPacket :: Get Packet 
getPacket = do 
    packet <- getWord32le 
    return $! packet 

getPackets :: BL.ByteString -> [Packet] 
getPackets input0 = go decoder input0 
    where 
    decoder = runGetIncremental getPacket 
    go :: Decoder Packet -> BL.ByteString -> [Packet] 
    go (Done leftover _consumed packet) input = 
     packet : go decoder (BL.chunk leftover input) 
    go (Partial k) input      = 
     go (k . takeHeadChunk $ input) (dropHeadChunk input) 
    go (Fail _leftover _consumed msg) _input = 
     [] 

takeHeadChunk :: BL.ByteString -> Maybe BS.ByteString 
takeHeadChunk lbs = 
    case lbs of 
    (BL.Chunk bs _) -> Just bs 
    _ -> Nothing 

dropHeadChunk :: BL.ByteString -> BL.ByteString 
dropHeadChunk lbs = 
    case lbs of 
    (BL.Chunk _ lbs') -> lbs' 
    _ -> BL.Empty 

Answer 1

Некоторые комментарии на ваш код:

1. Вы используете last, которые могли бы бросить исключение. Вы должны использовать lastMay из пакета safe, который возвращает Maybe.

2. Поскольку вы просто рассматриваете файл как вектор из Word32s, я не думаю, что стоит использовать Data.Binary.Get и связанные с этим накладные расходы и сложность, которые он влечет за собой. Просто обработайте файл как (возможно, ленивый) ByteString и получите доступ к каждому четвертому байту или разделите его на 4-байтовые подстроки.

Вы можете посмотреть код, который использует ByteStrings here. Он реализует следующие подходы к проблеме:

• Читать весь файл в ленивой байтовой строке и производить (отложенный) список 4-байтовые подстрок. Возвращает последнюю подстроку, которая удовлетворяет критериям.

  intoWords :: BL.ByteString -> [ BL.ByteString ] 
  intoWords bs 
      | BL.null a = [] 
      | otherwise = a : intoWords b 
      where (a,b) = BL.splitAt 4 bs 
  
  -- find by breaking the file into 4-byte words 
  find_C0_v1 :: FilePath -> IO (Maybe BL.ByteString) 
  find_C0_v1 path = do 
      contents <- BL.readFile path 
      return $ lastMay . filter (\bs -> BL.index bs 0 == 0xC0) . intoWords $ contents 
  

• Читать весь файл в ленивой байтовой строки и доступ каждый 4-й байт ищет 0xC0. Верните последнее вхождение.

  -- find by looking at every 4th byte 
  find_C0_v2 :: FilePath -> IO (Maybe BL.ByteString) 
  find_C0_v2 path = do 
      contents <- BL.readFile path 
      size <- fmap fromIntegral $ withFile path ReadMode hFileSize 
      let wordAt i = BL.take 4 . BL.drop i $ contents 
      return $ fmap wordAt $ lastMay $ filter (\i -> BL.index contents i == 0xC0) [0,4..size-1] 
  

• Прочтите файл в обратном порядке в кусках 64K. Внутри каждого фрагмента (который является строгим ByteString) доступ к каждому четвертому байту, который ищет 0xC0, начиная с конца фрагмента. Верните первое вхождение.

  -- read a file backwords until a predicate returns a Just value 
  loopBlocks :: Int -> Handle -> Integer -> (BS.ByteString -> Integer -> Maybe a) -> IO (Maybe a) 
  loopBlocks blksize h top pred 
      | top <= 0 = return Nothing 
      | otherwise = do 
       let offset = top - fromIntegral blksize 
       hSeek h AbsoluteSeek offset 
       blk <- BS.hGet h blksize 
       case pred blk offset of 
        Nothing -> loopBlocks blksize h offset pred 
        x  -> return x 
  
  -- find by reading backwords lookint at every 4th byte 
  find_C0_v3 :: FilePath -> IO (Maybe Integer) 
  find_C0_v3 path = do 
      withFile path ReadMode $ \h -> do 
      size <- hFileSize h 
      let top = size - (mod size 4) 
       blksize = 64*1024 :: Int 
      loopBlocks blksize h top $ \blk offset -> 
        fmap ((+offset) . fromIntegral) $ headMay $ filter (\i -> BS.index blk i == 0xC0) [blksize-4,blksize-8..0] 
  

Третий метод является самым быстрым, даже если он должен прочитать весь файл. Первый метод работает очень хорошо. Я бы не рекомендовал второй вообще - его производительность резко ухудшается по мере увеличения размера файла.

Answer 2

Для любых других, кто может быть заинтересован, я адаптировал ответ @ ErikR. Это решение следует его предложенному решению 3, но использует мой существующий код, путем ленивого перехода по блокам.

Это требует несколько дополнительных импорта:

import System.IO 
import Safe 
import Data.Maybe 

main становится:

main = do 
    args <- getArgs 
    let file = args!!0 
    putStrLn $ "Find last 0xCXXXXXXX in " ++ file 

    -- forward 
    withFile file ReadMode $ \h -> do 
    content <- BL.hGetContents h 
    let packets = getPackets content 
    putStrLn . show . getValue . last . filterTimes $ packets 

    -- reverse 
    withFile file ReadMode $ \h -> do 
    size <- hFileSize h 
    let blksize = 64*1024 :: Int 
    chunks <- makeReverseChunks blksize h (fromIntegral size) 
    putStrLn . show . getValue . (fromMaybe 0) . headMay . catMaybes . (map $ lastMay . filterTimes . getPackets) $ chunks 

С добавлением вспомогательной функции:

-- create list of data chunks, backwards in order through the file 
makeReverseChunks :: Int -> Handle -> Int -> IO [BL.ByteString] 
makeReverseChunks blksize h top 
    | top == 0 = return [] 
    | top < 0 = error "negative file index" 
    | otherwise = do 
     let offset = max (top - fromIntegral blksize) 0 
     hSeek h AbsoluteSeek (fromIntegral offset) 
     blk <- BL.hGet h blksize 
     rest <- makeReverseChunks blksize h offset 
     return $ blk : rest 

Answer 3

Вот вариация функции makeReverseChunks. В настоящее время он довольно строг. Более того, использование ленивых байтов не помогает, если держать blksize достаточно низко. Для достижения ленивого чтения нужно использовать unsafeInterleaveIO. Вот решение с использованием строгих байтовых строк и ленивые IO:

-- create list of data chunks, backwards in order through the file 
makeReverseChunks :: Int -> Handle -> Int -> IO [SBS.ByteString] 
makeReverseChunks blksize h top 
    | top == 0 = return [] 
    | top < 0 = error "negative file index" 
    | otherwise = do 
    let offset = max (top - fromIntegral blksize) 0 
    hSeek h AbsoluteSeek (fromIntegral offset) 
    blk <- SBS.hGet h blksize 
    rest <- unsafeInterleaveIO $ makeReverseChunks blksize h offset 
    return $ blk : rest