Haskell: Read a binary file backwards - file

Question

I'm looking to find the last 32bit word in an uInt32 binary dump matching a particular pattern using Haskell. I am able to complete the task using last, however the code must trawl through the entire file so it is rather inefficient.
Is there a simple way to make readfile operate through the file in reverse? I believe this would solve the issue with the smallest change to the current code.
Here is my current code, for reference. I only began with Haskell this weekend so I am sure it is quite ugly. It looks for the last 32 bit word beginning with 0b10 at the 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

Some comments on your code:
You are using last which could throw an exception. You should use lastMay fromthe safe package which returns a Maybe.
Since you are just treating the file as a vector of Word32s, I don't think it's worth using Data.Binary.Get and the associated overhead and complexity that it entails. Just treat the file as a (perhaps lazy) ByteString and access every 4th byte or break it up into 4-byte substrings.
You can have a look at code which uses ByteStrings here. It implements the following approaches to the problem:
Read in the entire file as a lazy ByteString and produce a (lazy) list of 4-byte substrings. Return the last substring which satisifies the criteria.
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
Read in the entire file as a lazy ByteString and access every 4-th byte looking for a 0xC0. Return the last occurrence.
-- 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]
Read the file in backwards in chunks of 64K. Within each chunk (which is a strict ByteString) access every 4th byte looking for a 0xC0 starting from the end of the chunk. Return the first occurrence.
-- 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]
The third method is the fastest even if it has to read in the entire file. The first method actually works pretty well. I wouldn't recommend the second at all - its performance degrades precipitously as the file size grows.

Answer 2

For any others who may be interested, I have adapted #ErikR's answer. This solution follows his proposed solution 3, but makes use of my existing code, by stepping through blocks in reverse lazily.
This requires a few extra imports:
import System.IO
import Safe
import Data.Maybe
main becomes:
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
With an added helper function:
-- 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

Here is a variation of the function makeReverseChunks. It was currently quite strict. Moreover the use of lazy bytestrings is not helping if one keep the blksize low enough. In order to achieve lazy reading one must use unsafeInterleaveIO. Here is a solution using strict bytestrings and lazy 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