2015-06-16 5 views
2

Учитывая png-файл, я пытаюсь получить список смещений и размеров его кусков.Лучший способ писать циклы в IO

Вкратце, png files изготовлены из кусков, и каждый кусок состоит из трех 4-байтовых полей плюс одно поле переменной длины (поле данных куска). Размер поля данных сохраняется в первом 4-байтовом поле (которое называется полем «длина»).

Поэтому с учетом текущей порции этого смещением и размером, (ФС, С.З.), один получает следующий фрагмент это смещения и размера, (ФС, SZ '), таким образом:

ФСУ' = ФС + SZ

чтения SZ»на смещение = OFS'

Учитывая начальный кусок это смещение и размер, всегда (0, 8) в PNG файлах, можно перебрать файл, пока один достигает своей цели. Вот как я это сделал:

import Data.Word 
import qualified Data.ByteString.Lazy as BS 
import Data.Binary.Get 

size :: BS.ByteString -> Int -> IO (Int) 
size bytes offset = do 
    let ln = runGet (do skip offset 
         l <- getWord32be 
         return l) 
        bytes 
    return $ 3*4 + fromIntegral ln 

offsetSizes :: Int -> BS.ByteString -> [(Int, Int)] -> IO [(Int, Int)] 
offsetSizes fLen bytes oss = do 
     let (offset, sz) = last oss 
      offset' = offset + sz 
     sz' <- size bytes offset' 
     let nextOffset = offset' + sz' 
     if nextOffset < fLen then offsetSizes fLen bytes $ oss ++ [(offset', sz')] 
           else return oss 
main = do 
    contents <- BS.readFile "myfile.png" 
    let fLen = fromIntegral $ BS.length contents :: Int 

    ofszs <- offsetSizes fLen contents [(0,8)] 
    putStrLn $ "# of chunks: " ++ (show $ length ofszs) 
    putStrLn $ "chunks [(offset,size)]: " ++ show ofszs 

Мой вопрос: Я не очень доволен цикла. Мне было интересно, есть ли более идиоматический способ добиться этого в Haskell?

+1

Я хотел бы использовать что-то вроде [unfoldrM] (https://hackage.haskell.org/package/ monad-loops-0.4.2.1/docs/Control-Monad-Loops.html # v: unfoldrM) в 'offsetSizes'; Кроме того, вы можете написать 'let ln = runGet (skip offset >> getWord32be) bytes', чтобы сделать его более простым. – Cactus

+5

Цикл не так уж плох. Вместо того, чтобы выглядеть плохо, это повторяющийся 'oss ++ [(offset ', sz')]', который неэффективен. Было бы лучше использовать '(offset ', sz'): oss', чтобы создать обратный список, а затем, наконец, отменить его, как только цикл закончен. Это также позволит вам избежать 'last oss', который медленный. – chi

+0

спасибо за предложение, я попробую это. – Janthelme

ответ

1

offsetSizes неоднократно подавали определенное состояние (пара (offset, sz)) для производства новой пары или завершения. Все созданные пары собраны в список.

Эта схема рекурсии захватывается unfoldrM из monad-loops пакета, что позволяет писать offsetSizes в

offsetSizes :: Int -> BS.ByteString -> IO [(Int, Int)] 
offsetSizes fLen bytes = unfoldrM step (0, 8) 
    where 
    step (offset, sz) = do 
     let offset' = offset + sz 
     sz' <- size bytes offset' 
     let state' = (offset', sz') 
     return $ if offset' + sz' < fLen then Just (state', state') else Nothing 
Смежные вопросы