{-# LANGUAGE Rank2Types #-} -- Random and Binary IO with IterateeM -- A general-purpose TIFF library -- The library gives the user the TIFF dictionary, which the user -- can search for specific tags and obtain the values associated with -- the tags, including the pixel matrix. -- -- The overarching theme is incremental processing: initially, -- only the TIFF dictionary is read. The value associated with a tag -- is read only when that tag is looked up (unless the value was short -- and was packed in the TIFF dictionary entry). The pixel matrix -- (let alone the whole TIFF file) is not loaded in memory -- -- the pixel matrix is not even located before it is needed. -- The matrix is processed incrementally, by a user-supplied -- iteratee. -- -- The incremental processing is accomplished by iteratees and enumerators. -- The enumerators are indeed first-class, they are stored -- in the interned TIFF dictionary data structure. These enumerators -- represent the values associated with tags; the values will be read -- on demand, when the enumerator is applied to a user-given iteratee. -- -- The library extensively uses nested streams, tacitly converting the -- stream of raw bytes from the file into streams of integers, -- rationals and other user-friendly items. The pixel matrix is -- presented as a contiguous stream, regardless of its segmentation -- into strips and physical arrangement. -- The library exhibits random IO and binary parsing, reading -- of multi-byte numeric data in big- or little-endian formats. -- The library can be easily adopted for AIFF, RIFF and other -- IFF formats. -- -- We show a representative application of the library: reading a sample -- TIFF file, printing selected values from the TIFF dictionary, -- verifying the values of selected pixels and computing the histogram -- of pixel values. The pixel verification procedure stops reading the -- pixel matrix as soon as all specified pixel values are verified. -- The histogram accumulation does read the entire matrix, but -- incrementally. Neither pixel matrix processing procedure loads -- the whole matrix in memory. In fact, we never read and retain -- more than the IO-buffer-full of raw data. -- This TIFF library is to be contrasted with the corresponding Scheme -- code: -- http://okmij.org/ftp/Scheme/binary-io.html#tiff -- The main distinction is using iteratees for on-demand processing. module Data.Iteratee.Codecs.Tiff where import Data.Iteratee.Base (StreamG (..), IterateeG (..), IterateeGM, EnumeratorGMM, EnumeratorN, bindm, liftI, (==<<), (>.), (>>==), iterErr, enumErr, convStream, iterReportError, enumEof) import qualified Data.Iteratee.Base as Iter import qualified Data.Iteratee.Base.StreamChunk as SC import Data.Iteratee.Binary import Control.Monad.State import Data.Char (chr) import Data.Int import Data.Word import Data.Ratio import Data.Maybe import qualified Data.IntMap as IM -- ======================================================================== -- Sample TIFF user code -- The following is sample code using the TIFF library (whose implementation -- is in the second part of this file). -- Our sample code prints interesting information from the TIFF -- dictionary (such as the dimensions, the resolution and the name -- of the image) -- The main user function. tiff_reader is the library function, -- which builds the TIFF dictionary. -- process_tiff is the user function, to extract useful data -- from the dictionary -- test_tiff :: IO (Maybe String) -- test_tiff = test_driver_random (tiff_reader >>= process_tiff) "filename.tiff" -- Sample TIFF processing function process_tiff :: MonadIO m => Maybe (IM.IntMap TIFFDE) -> IterateeGM [] Word8 m (Maybe String) process_tiff Nothing = return $ Just "No dictionary" process_tiff (Just dict) = do note ["dict size: ", show $ IM.size dict] -- Check tag values against the known values for the sample image check_tag TG_IMAGEWIDTH (flip dict_read_int dict) 129 check_tag TG_IMAGELENGTH (flip dict_read_int dict) 122 check_tag TG_BITSPERSAMPLE (flip dict_read_int dict) 8 check_tag TG_IMAGEDESCRIPTION (flip dict_read_string dict) "JPEG:gnu-head-sm.jpg 129x122" check_tag TG_COMPRESSION (flip dict_read_int dict) 1 check_tag TG_SAMPLESPERPIXEL (flip dict_read_int dict) 1 check_tag TG_STRIPBYTECOUNTS (flip dict_read_int dict) 15738 -- nrows*ncols check_tag TG_XRESOLUTION (flip dict_read_rat dict) (72%1) check_tag TG_YRESOLUTION (flip dict_read_rat dict) (72%1) (n,hist) <- compute_hist dict note ["computed histogram over ", show n, " values\n", show hist] iterReportError >>= maybe (return ()) error note ["Verifying values of sample pixels"] verify_pixel_vals dict [(0,255), (17,248)] err <- iterReportError maybe (return ()) error err return err where check_tag tag action v = do vc <- action tag case vc of Just v' | v' == v -> note ["Tag ",show tag, " value ", show v] _ -> error $ unwords ["Tag", show tag, "unexpected:", show vc] -- process_tiff Nothing = return Nothing -- sample processing of the pixel matrix: computing the histogram compute_hist :: MonadIO m => TIFFDict -> IterateeGM [] Word8 m (Int,IM.IntMap Int) compute_hist dict = Iter.joinI $ pixel_matrix_enum dict ==<< compute_hist' 0 IM.empty where compute_hist' count = liftI . Cont .step count step count hist (Chunk ch) | SC.null ch = compute_hist' count hist | otherwise = compute_hist' (count + SC.length ch) (foldr accum hist ch) step count hist s = liftI $ Done (count,hist) s accum e = IM.insertWith (+) (fromIntegral e) 1 -- Another sample processor of the pixel matrix: verifying values of -- some pixels -- This processor does not read the whole matrix; it stops as soon -- as everything is verified or the error is detected verify_pixel_vals :: MonadIO m => TIFFDict -> [(IM.Key, Word8)] -> IterateeGM [] Word8 m () verify_pixel_vals dict pixels = Iter.joinI $ pixel_matrix_enum dict ==<< verify 0 (IM.fromList pixels) where verify _ m | IM.null m = return () verify n m = liftI $ Cont (step n m) step n m (Chunk xs) | SC.null xs = verify n m | otherwise = let (h, t) = (SC.head xs, SC.tail xs) in case IM.updateLookupWithKey (\_k _e -> Nothing) n m of (Just v,m') -> if v == h then step (succ n) m' (Chunk t) else iterErr $ unwords ["Pixel #",show n, "expected:",show v, "found", show h] (Nothing,m')-> step (succ n) m' (Chunk t) step _n _m s = liftI $ Done () s -- ======================================================================== -- TIFF library code -- A TIFF directory is a finite map associating a TIFF tag with -- a record TIFFDE type TIFFDict = IM.IntMap TIFFDE data TIFFDE = TIFFDE{tiffde_count :: Int, -- number of items tiffde_enum :: TIFFDE_ENUM -- enumerator to get values } data TIFFDE_ENUM = TEN_CHAR (forall a m. Monad m => EnumeratorGMM [] Word8 [] Char m a) | TEN_BYTE (forall a m. Monad m => EnumeratorGMM [] Word8 [] Word8 m a) | TEN_INT (forall a m. Monad m => EnumeratorGMM [] Word8 [] Int m a) | TEN_RAT (forall a m. Monad m => EnumeratorGMM [] Word8 [] (Ratio Int) m a) -- Standard TIFF data types data TIFF_TYPE = TT_NONE -- 0 | TT_byte -- 1 8-bit unsigned integer | TT_ascii -- 2 8-bit bytes with last byte null | TT_short -- 3 16-bit unsigned integer | TT_long -- 4 32-bit unsigned integer | TT_rational -- 5 64-bit fractional (numer+denominator) -- The following was added in TIFF 6.0 | TT_sbyte -- 6 8-bit signed (2s-complement) integer | TT_undefined -- 7 An 8-bit byte, "8-bit chunk" | TT_sshort -- 8 16-bit signed (2s-complement) integer | TT_slong -- 9 32-bit signed (2s-complement) integer | TT_srational -- 10 "signed rational", two SLONGs (num+denominator) | TT_float -- 11 "IEEE 32-bit float", single precision (4-byte) | TT_double -- 12 "IEEE 64-bit double", double precision (8-byte) deriving (Eq, Enum, Ord, Bounded, Show) -- Standard TIFF tags data TIFF_TAG = TG_other Int -- other than below | TG_SUBFILETYPE -- subfile data descriptor | TG_OSUBFILETYPE -- +kind of data in subfile | TG_IMAGEWIDTH -- image width in pixels | TG_IMAGELENGTH -- image height in pixels | TG_BITSPERSAMPLE -- bits per channel (sample) | TG_COMPRESSION -- data compression technique | TG_PHOTOMETRIC -- photometric interpretation | TG_THRESHOLDING -- +thresholding used on data | TG_CELLWIDTH -- +dithering matrix width | TG_CELLLENGTH -- +dithering matrix height | TG_FILLORDER -- +data order within a byte | TG_DOCUMENTNAME -- name of doc. image is from | TG_IMAGEDESCRIPTION -- info about image | TG_MAKE -- scanner manufacturer name | TG_MODEL -- scanner model name/number | TG_STRIPOFFSETS -- offsets to data strips | TG_ORIENTATION -- +image orientation | TG_SAMPLESPERPIXEL -- samples per pixel | TG_ROWSPERSTRIP -- rows per strip of data | TG_STRIPBYTECOUNTS -- bytes counts for strips | TG_MINSAMPLEVALUE -- +minimum sample value | TG_MAXSAMPLEVALUE -- maximum sample value | TG_XRESOLUTION -- pixels/resolution in x | TG_YRESOLUTION -- pixels/resolution in y | TG_PLANARCONFIG -- storage organization | TG_PAGENAME -- page name image is from | TG_XPOSITION -- x page offset of image lhs | TG_YPOSITION -- y page offset of image lhs | TG_FREEOFFSETS -- +byte offset to free block | TG_FREEBYTECOUNTS -- +sizes of free blocks | TG_GRAYRESPONSEUNIT -- gray scale curve accuracy | TG_GRAYRESPONSECURVE -- gray scale response curve | TG_GROUP3OPTIONS -- 32 flag bits | TG_GROUP4OPTIONS -- 32 flag bits | TG_RESOLUTIONUNIT -- units of resolutions | TG_PAGENUMBER -- page numbers of multi-page | TG_COLORRESPONSEUNIT -- color scale curve accuracy | TG_COLORRESPONSECURVE -- RGB response curve | TG_SOFTWARE -- name & release | TG_DATETIME -- creation date and time | TG_ARTIST -- creator of image | TG_HOSTCOMPUTER -- machine where created | TG_PREDICTOR -- prediction scheme w/ LZW | TG_WHITEPOINT -- image white point | TG_PRIMARYCHROMATICITIES -- primary chromaticities | TG_COLORMAP -- RGB map for pallette image | TG_BADFAXLINES -- lines w/ wrong pixel count | TG_CLEANFAXDATA -- regenerated line info | TG_CONSECUTIVEBADFAXLINES -- max consecutive bad lines | TG_MATTEING -- alpha channel is present deriving (Eq, Show) tag_map :: Num t => [(TIFF_TAG, t)] tag_map = [ (TG_SUBFILETYPE,254), (TG_OSUBFILETYPE,255), (TG_IMAGEWIDTH,256), (TG_IMAGELENGTH,257), (TG_BITSPERSAMPLE,258), (TG_COMPRESSION,259), (TG_PHOTOMETRIC,262), (TG_THRESHOLDING,263), (TG_CELLWIDTH,264), (TG_CELLLENGTH,265), (TG_FILLORDER,266), (TG_DOCUMENTNAME,269), (TG_IMAGEDESCRIPTION,270), (TG_MAKE,271), (TG_MODEL,272), (TG_STRIPOFFSETS,273), (TG_ORIENTATION,274), (TG_SAMPLESPERPIXEL,277), (TG_ROWSPERSTRIP,278), (TG_STRIPBYTECOUNTS,279), (TG_MINSAMPLEVALUE,280), (TG_MAXSAMPLEVALUE,281), (TG_XRESOLUTION,282), (TG_YRESOLUTION,283), (TG_PLANARCONFIG,284), (TG_PAGENAME,285), (TG_XPOSITION,286), (TG_YPOSITION,287), (TG_FREEOFFSETS,288), (TG_FREEBYTECOUNTS,289), (TG_GRAYRESPONSEUNIT,290), (TG_GRAYRESPONSECURVE,291), (TG_GROUP3OPTIONS,292), (TG_GROUP4OPTIONS,293), (TG_RESOLUTIONUNIT,296), (TG_PAGENUMBER,297), (TG_COLORRESPONSEUNIT,300), (TG_COLORRESPONSECURVE,301), (TG_SOFTWARE,305), (TG_DATETIME,306), (TG_ARTIST,315), (TG_HOSTCOMPUTER,316), (TG_PREDICTOR,317), (TG_WHITEPOINT,318), (TG_PRIMARYCHROMATICITIES,319), (TG_COLORMAP,320), (TG_BADFAXLINES,326), (TG_CLEANFAXDATA,327), (TG_CONSECUTIVEBADFAXLINES,328), (TG_MATTEING,32995) ] tag_map' :: IM.IntMap TIFF_TAG tag_map' = IM.fromList $ map (\(tag,v) -> (v,tag)) tag_map tag_to_int :: TIFF_TAG -> Int tag_to_int (TG_other x) = x tag_to_int x = fromMaybe (error $ "not found tag: " ++ show x) $ lookup x tag_map int_to_tag :: Int -> TIFF_TAG int_to_tag x = fromMaybe (TG_other x) $ IM.lookup x tag_map' -- The library function to read the TIFF dictionary tiff_reader :: IterateeGM [] Word8 IO (Maybe TIFFDict) tiff_reader = do endian <- read_magic check_version case endian of Just e -> bindm (endian_read4 e) $ \dict_offset -> do Iter.seek (fromIntegral dict_offset) load_dict e Nothing -> return Nothing where -- Read the magic and set the endianness read_magic = do c1 <- Iter.head c2 <- Iter.head case (c1,c2) of (Just 0x4d, Just 0x4d) -> return $ Just MSB (Just 0x49, Just 0x49) -> return $ Just LSB _ -> (iterErr $ "Bad TIFF magic word: " ++ show [c1,c2]) >> return Nothing -- Check the version in the header. It is always ... tiff_version = 42 check_version = do v <- endian_read2 MSB case v of Just v' | v' == tiff_version -> return () _ -> iterErr $ "Bad TIFF version: " ++ show v -- A few conversion procedures u32_to_float :: Word32 -> Double u32_to_float _x = -- unsigned 32-bit int -> IEEE float error "u32->float is not yet implemented" u32_to_s32 :: Word32 -> Int32 -- unsigned 32-bit int -> signed 32 bit u32_to_s32 = fromIntegral -- u32_to_s32 0x7fffffff == 0x7fffffff -- u32_to_s32 0xffffffff == -1 u16_to_s16 :: Word16 -> Int16 -- unsigned 16-bit int -> signed 16 bit u16_to_s16 = fromIntegral -- u16_to_s16 32767 == 32767 -- u16_to_s16 32768 == -32768 -- u16_to_s16 65535 == -1 u8_to_s8 :: Word8 -> Int8 -- unsigned 8-bit int -> signed 8 bit u8_to_s8 = fromIntegral -- u8_to_s8 127 == 127 -- u8_to_s8 128 == -128 -- u8_to_s8 255 == -1 note :: (MonadIO m) => [String] -> IterateeGM [] el m () note = lift . liftIO . putStrLn . concat -- An internal function to load the dictionary. It assumes that the stream -- is positioned to read the dictionary load_dict :: MonadIO m => Endian -> IterateeGM [] Word8 m (Maybe TIFFDict) load_dict e = bindm (endian_read2 e) $ \nentries -> do dict <- foldr (const read_entry) (return (Just IM.empty)) [1..nentries] bindm (endian_read4 e) $ \next_dict -> do when (next_dict > 0) $ note ["The TIFF file contains several images, ", "only the first one will be considered"] return dict where read_entry dictM = bindm dictM $ \dict -> bindm (endian_read2 e) $ \tag -> bindm (endian_read2 e) $ \typ' -> bindm (convert_type (fromIntegral typ')) $ \typ -> bindm (endian_read4 e) $ \count -> do -- we read the val-offset later. We need to check the size and the type -- of the datum, because val-offset may contain the value itself, -- in its lower-numbered bytes, regardless of the big/little endian -- order! note ["TIFFEntry: tag ",show . int_to_tag . fromIntegral $ tag, " type ", show typ, " count ", show count] enum_m <- read_value typ e (fromIntegral count) case enum_m of Just enum -> return . Just $ IM.insert (fromIntegral tag) (TIFFDE (fromIntegral count) enum) dict _ -> return (Just dict) convert_type :: (Monad m) => Int -> IterateeGM [] el m (Maybe TIFF_TYPE) convert_type typ | typ > 0 && typ <= fromEnum (maxBound::TIFF_TYPE) = return . Just . toEnum $ typ convert_type typ = do iterErr $ "Bad type of entry: " ++ show typ return Nothing read_value :: MonadIO m => TIFF_TYPE -> Endian -> Int -> IterateeGM [] Word8 m (Maybe TIFFDE_ENUM) read_value typ e' 0 = bindm (endian_read4 e') $ \_offset -> do iterErr $ "Zero count in the entry of type: " ++ show typ return Nothing -- Read an ascii string from the offset in the -- dictionary. The last byte of -- an ascii string is always zero, which is -- included in 'count' but we don't need to read it read_value TT_ascii e' count | count > 4 = -- for sure, val-offset is offset bindm (endian_read4 e') $ \offset -> return . Just . TEN_CHAR $ \iter_char -> do Iter.seek (fromIntegral offset) let iter = convStream (bindm Iter.head (return. Just .(:[]). chr . fromIntegral)) iter_char Iter.joinI $ Iter.joinI $ Iter.takeR (pred count) ==<< iter -- Read the string of 0 to 3 characters long -- The zero terminator is included in count, but -- we don't need to read it read_value TT_ascii _e count = do -- count is within 1..4 let len = pred count -- string length let loop acc 0 = return . Just . reverse $ acc loop acc n = bindm Iter.head (\v -> loop ((chr . fromIntegral $ v):acc) (pred n)) bindm (loop [] len) $ \str -> do Iter.drop (4-len) return . Just . TEN_CHAR $ immed_value str -- Read the array of signed or unsigned bytes read_value typ e' count | count > 4 && typ == TT_byte || typ == TT_sbyte = bindm (endian_read4 e') $ \offset -> return . Just . TEN_INT $ \iter_int -> do Iter.seek (fromIntegral offset) let iter = convStream (bindm Iter.head (return . Just . (:[]) . conv_byte typ)) iter_int Iter.joinI $ Iter.joinI $ Iter.takeR count ==<< iter -- Read the array of 1 to 4 bytes read_value typ _e count | typ == TT_byte || typ == TT_sbyte = do let loop acc 0 = return . Just . reverse $ acc loop acc n = bindm Iter.head (\v -> loop (conv_byte typ v:acc) (pred n)) bindm (loop [] count) $ \str -> do Iter.drop (4-count) return . Just . TEN_INT $ immed_value str -- Read the array of Word8 read_value TT_undefined e' count | count > 4 = bindm (endian_read4 e') $ \offset -> return . Just . TEN_BYTE $ \iter -> do Iter.seek (fromIntegral offset) Iter.joinI $ Iter.takeR count iter -- Read the array of Word8 of 1..4 elements, -- packed in the offset field read_value TT_undefined _e count = do let loop acc 0 = return . Just . reverse $ acc loop acc n = bindm Iter.head (\v -> loop (v:acc) (pred n)) bindm (loop [] count) $ \str -> do Iter.drop (4-count) return . Just . TEN_BYTE $ immed_value str -- Read the array of short integers -- of 1 element: the offset field contains the value read_value typ e' 1 | typ == TT_short || typ == TT_sshort = bindm (endian_read2 e') $ \item -> do Iter.drop 2 -- skip the padding return . Just . TEN_INT $ immed_value [conv_short typ item] -- of 2 elements: the offset field contains the value read_value typ e' 2 | typ == TT_short || typ == TT_sshort = bindm (endian_read2 e') $ \i1 -> bindm (endian_read2 e') $ \i2 -> return . Just . TEN_INT $ immed_value [conv_short typ i1, conv_short typ i2] -- of n elements read_value typ e' count | typ == TT_short || typ == TT_sshort = bindm (endian_read4 e') $ \offset -> return . Just . TEN_INT $ \iter_int -> do Iter.seek (fromIntegral offset) let iter = convStream (bindm (endian_read2 e') (return . Just . (:[]) . conv_short typ)) iter_int Iter.joinI $ Iter.joinI $ Iter.takeR (2*count) ==<< iter -- Read the array of long integers -- of 1 element: the offset field contains the value read_value typ e' 1 | typ == TT_long || typ == TT_slong = bindm (endian_read4 e') $ \item -> return . Just . TEN_INT $ immed_value [conv_long typ item] -- of n elements read_value typ e' count | typ == TT_long || typ == TT_slong = bindm (endian_read4 e') $ \offset -> return . Just . TEN_INT $ \iter_int -> do Iter.seek (fromIntegral offset) let iter = convStream (bindm (endian_read4 e') (return . Just . (:[]) . conv_long typ)) iter_int Iter.joinI $ Iter.joinI $ Iter.takeR (4*count) ==<< iter -- Read the array of rationals. A rational can't -- be packed into the offset field {- read_value typ e count | typ == TT_rational || typ == TT_srational = do bindm (endian_read4 e) $ \offset -> return . Just . TEN_RAT $ \iter_rat -> do Iter.seek (fromIntegral offset) let iter = convStream (bindm (endian_read4 e) $ \i1 -> bindm (endian_read4 e) $ \i2 -> (return . Just . (:[]) $ conv_rat typ i1 i2)) iter_rat Iter.joinI $ Iter.joinI $ Iter.takeR (8*count) ==<< iter -} read_value typ e' count = -- stub bindm (endian_read4 e') $ \_offset -> do note ["unhandled type: ", show typ, " with count ", show count] return Nothing immed_value :: (Monad m) => [el] -> EnumeratorGMM [] Word8 [] el m a immed_value item iter = (Iter.enumPure1Chunk item >. enumEof) iter >>== Iter.joinI . return conv_byte :: TIFF_TYPE -> Word8 -> Int conv_byte TT_byte = fromIntegral conv_byte TT_sbyte = fromIntegral . u8_to_s8 conv_byte _ = error "This should never happen" conv_short :: TIFF_TYPE -> Word16 -> Int conv_short TT_short = fromIntegral conv_short TT_sshort = fromIntegral . u16_to_s16 conv_short _ = error "This should never happen" conv_long :: TIFF_TYPE -> Word32 -> Int conv_long TT_long = fromIntegral conv_long TT_slong = fromIntegral . u32_to_s32 conv_long _ = error "This should never happen" {- this code is never used... conv_rat :: TIFF_TYPE -> Word32 -> Word32 -> Rational conv_rat TT_rational v1 v2 = (fromIntegral v1) % (fromIntegral v2) conv_rat TT_srational v1 v2 = (fromIntegral (u32_to_s32 v1)) % (fromIntegral (u32_to_s32 v2)) conv_rat _tt _ _ = error "This should never happen" -} -- Reading the pixel matrix -- For simplicity, we assume no compression and 8-bit pixels pixel_matrix_enum :: MonadIO m => TIFFDict -> EnumeratorN [] Word8 [] Word8 m a pixel_matrix_enum dict iter = validate_dict >>= proceed where -- Make sure we can handle this particular TIFF image validate_dict = dict_assert TG_COMPRESSION 1 `bindm` \() -> dict_assert TG_SAMPLESPERPIXEL 1 `bindm` \() -> dict_assert TG_BITSPERSAMPLE 8 `bindm` \() -> dict_read_int TG_IMAGEWIDTH dict `bindm` \ncols -> dict_read_int TG_IMAGELENGTH dict `bindm` \nrows -> dict_read_ints TG_STRIPOFFSETS dict `bindm` \strip_offsets -> do rps <- liftM (fromMaybe nrows) (dict_read_int TG_ROWSPERSTRIP dict) if ncols > 0 && nrows > 0 && rps > 0 then return $ Just (ncols,nrows,rps,strip_offsets) else return Nothing dict_assert tag v = do vfound <- dict_read_int tag dict case vfound of Just v' | v' == v -> return $ Just () _ -> iterErr (unwords ["dict_assert: tag:", show tag, "expected:", show v, "found:", show vfound]) >> return Nothing proceed Nothing = enumErr "Can't handle this TIFF" iter >>== return proceed (Just (ncols,nrows,rows_per_strip,strip_offsets)) = do let strip_size = rows_per_strip * ncols image_size = nrows * ncols note ["Processing the pixel matrix, ", show image_size, " bytes"] let loop _pos _ iter'@Done{} = return iter' loop _pos [] iter' = return iter' loop pos (strip:strips) iter' = do Iter.seek (fromIntegral strip) let len = min strip_size (image_size - pos) iter'' <- Iter.takeR (fromIntegral len) iter' loop (pos+len) strips iter'' loop 0 strip_offsets iter -- A few helpers for getting data from TIFF dictionary dict_read_int :: Monad m => TIFF_TAG -> TIFFDict -> IterateeGM [] Word8 m (Maybe Int) dict_read_int tag dict = do els <- dict_read_ints tag dict case els of Just (e:_) -> return $ Just e _ -> return Nothing dict_read_ints :: Monad m => TIFF_TAG -> TIFFDict -> IterateeGM [] Word8 m (Maybe [Int]) dict_read_ints tag dict = case IM.lookup (tag_to_int tag) dict of Just (TIFFDE _ (TEN_INT enum)) -> do e <- enum ==<< Iter.stream2list return (Just e) _ -> return Nothing dict_read_rat :: Monad m => TIFF_TAG -> TIFFDict -> IterateeGM [] Word8 m (Maybe (Ratio Int)) dict_read_rat tag dict = case IM.lookup (tag_to_int tag) dict of Just (TIFFDE 1 (TEN_RAT enum)) -> do [e] <- enum ==<< Iter.stream2list return (Just e) _ -> return Nothing dict_read_string :: Monad m => TIFF_TAG -> TIFFDict -> IterateeGM [] Word8 m (Maybe String) dict_read_string tag dict = case IM.lookup (tag_to_int tag) dict of Just (TIFFDE _ (TEN_CHAR enum)) -> do e <- enum ==<< Iter.stream2list return (Just e) _ -> return Nothing