-- | This module contains the code to read (or parse) the exif file. -- This module is an internal module of Graphics.Hexif -- and should only be used in the hexif project! module Graphics.Hexif.Reader where import Graphics.Hexif.DataExif import Graphics.Hexif.Utils import Data.Char (chr) import Control.Monad(replicateM) import Data.Binary import Data.Binary.Get import qualified Data.ByteString.Lazy as BL -- | Offset into the lazy ByteString type Offset = Int -- | A list of file entries builds a directory. type IFDDir = [IFDEntry] -- | Representation of a physical IFD Entry in the exif file data IFDEntry = IFDEntry Word16 Word16 Int BL.ByteString | IFDSubDir DirTag IFDDir deriving (Eq, Show) -- | Little support function to read 16 bit integers getWord16 :: Encoding -> Get Word16 getWord16 Motorola = getWord16be getWord16 Intel = getWord16le -- | Little support function to read 32 bit integers getWord32 :: Encoding -> Get Word32 getWord32 Motorola = getWord32be getWord32 Intel = getWord32le -- | Read whole Exif file into our Haskell exif value. -- The ByteString parameter starts with the EXIF__ constant. readExif :: BL.ByteString -> Exif readExif bsExif6 = Exif mainDirs encoding where bsExif = BL.drop 6 bsExif6 mainDirs = convertDir IFDMain bsExif encoding ifdDirs ifdDirs = concat $ readIFDDirs IFDMain offset encoding bsExif (encoding, offset) = readHeader bsExif -- | Read the header data from a ByteString representing an EXIF file readHeader :: BL.ByteString -> (Encoding, Offset) readHeader = runGet getHeader where getHeader :: Get (Encoding, Offset) getHeader = do -- Tiff Header tiffAlign <- getWord16be let encoding = if fromIntegral tiffAlign == (0x4949::Int) then Intel else Motorola _ <- getByteString 2 -- const 2A -- Get offset to main directory offset <- getWord32 encoding return (encoding, fromIntegral offset) -- | Read chained IFD Dirs from a given offset. readIFDDirs :: DirTag -> Offset -> Encoding -> BL.ByteString -> [IFDDir] readIFDDirs dirTag offset encoding bsExif = if offset == 0 then [] else [debug] : block : blocks -- else block : blocks -- without debugging where (next, block) = readIFDDir offset encoding bsExif blocks = readIFDDirs dirTag next encoding bsExif debug = IFDEntry (dirTagToWord16 dirTag) 0 offset (BL.pack []) -- debug entry -- | Read a single IFD Directory from a given offset readIFDDir :: Offset -> Encoding -> BL.ByteString -> (Offset, IFDDir) readIFDDir offset encoding bsExif = runGet getIFDDir bsExif where -- Get IFD directory and the offset pointing to the next chained IFD. getIFDDir :: Get (Offset, IFDDir) getIFDDir = do skip offset nEntries <- getWord16 encoding block <- getIFDDirEntries (fromIntegral nEntries) encoding bsExif next <- getWord32 encoding return (fromIntegral next, block) -- | Get all the entries of an IFD getIFDDirEntries :: Int -> Encoding -> BL.ByteString -> Get IFDDir getIFDDirEntries count encoding bsExif = if count == 0 then return [] else do entry <- getIFDEntry entries <- getIFDDirEntries (count - 1) encoding bsExif return $ entry : entries where -- Get a single IFD entry. getIFDEntry = do tag <- getWord16 encoding fmt <- getWord16 encoding comps <- getWord32 encoding strBsValue <- getLazyByteString 4 return $ buildEntry tag fmt comps strBsValue -- Read subdirectories here buildEntry tg fm cmps strBsVal = case toDirTag tg of Just dirTag -> IFDSubDir dirTag (concat $ readIFDDirs dirTag offset encoding bsExif) Nothing -> IFDEntry tg fm (fromIntegral cmps) strBsVal where offset = fromIntegral (runGet (getWord32 encoding) strBsVal) -- | Convert IFD Entries to DataEntries convertDir :: DirTag -> BL.ByteString -> Encoding -> IFDDir -> DataBlock convertDir dirTag bsExif encoding = map (convertEntry dirTag bsExif encoding) -- | Convert a single IFDEntry convertEntry :: DirTag -> BL.ByteString -> Encoding -> IFDEntry -> DataEntry convertEntry _ bsExif encoding (IFDSubDir dTg ifdDir) = DataSub dTg (convertDir dTg bsExif encoding ifdDir) convertEntry dirTag bsExif encoding (IFDEntry tg fmt len strBsValue) = case fmt of 0 -> DataNum exifTag Fmt00 len -- debug entry 1 -> DataStr exifTag Fmt01 (byteValues exifTag offsetOrValue32 len) 2 -> DataStr exifTag Fmt02 (stringValue exifTag len strBsValue gW32 bsExif) 3 -> DataNum exifTag Fmt03 offsetOrValue16 4 -> DataNum exifTag Fmt04 offsetOrValue32 5 -> DataRat exifTag Fmt05 (rationalValues len offsetOrValue32 bsExif encoding) 7 -> DataUdf exifTag Fmt07 len (unpackLazyBS strBsValue) 9 -> DataNum exifTag Fmt09 offsetOrValue32 10 -> DataRat exifTag Fmt10 (rationalValues len offsetOrValue32 bsExif encoding) _ -> error $ "Format " ++ show fmt ++ " not yet implemented" where exifTag = toExifTag dirTag tg offsetOrValue32 = fromIntegral (runGet gW32 strBsValue) offsetOrValue16 = fromIntegral (runGet gW16 strBsValue) gW32 = getWord32 encoding gW16 = getWord16 encoding byteValues TagGPSVersionID _ _ = concatMap show (BL.unpack strBsValue) byteValues TagGPSAltitudeRef _ _ = show $ head $ BL.unpack strBsValue byteValues _ offset ln = map (chr . fromIntegral) $ runGet (skip offset >> replicateM ln getWord8) bsExif -- formats -- 0x0001 = unsigned byte -- 0x0002 = ascii string -- 0x0003 = unsigned short -- 0x0004 = unsigned long -- 0x0005 = unsigned rational -- 0x0007 = undefined -- 0x0009 = signed long -- 0x000A = signed rationale -- subfunctions of convert -- | Read out a string value. -- Note: Some tags have non standard representation -> Special cases stringValue :: ExifTag -> Int -> BL.ByteString -> Get Word32 -> BL.ByteString -> String stringValue TagSubsecTime len strBsValue _ _ = take len (unpackLazyBS strBsValue) stringValue TagSubSecTimeOriginal len strBsValue _ _ = take len (unpackLazyBS strBsValue) stringValue TagSubSecTimeDigitized len strBsValue _ _ = take len (unpackLazyBS strBsValue) stringValue TagGPSLatitudeRef _ strBsValue _ _ = directByte strBsValue stringValue TagGPSLongitudeRef _ strBsValue _ _ = directByte strBsValue stringValue TagGPSDestLatitudeRef _ strBsValue _ _ = directByte strBsValue stringValue TagGPSDestLongitudeRef _ strBsValue _ _ = directByte strBsValue stringValue TagGPSImgDirectionRef _ strBsValue _ _ = directByte strBsValue stringValue TagInteroperabilityIndex _ strBsValue _ _ = take 3 (unpackLazyBS strBsValue) stringValue _ len strBsValue gW32 bsExif = runGet getStringValue bsExif where offset = fromIntegral (runGet gW32 strBsValue) getStringValue = do skip offset lazy <- getLazyByteString $ fromIntegral (len - 1) return $ unpackLazyBS lazy -- | Fetch a direct byte directByte :: BL.ByteString -> String directByte strBsValue = take 1 (unpackLazyBS strBsValue) -- | Read the rational values of on exif tag rationalValues :: Int -> Int -> BL.ByteString -> Encoding -> [(Int, Int)] rationalValues comps offset bsExif encoding = runGet getRationalValues bsExif where getRationalValues :: Get [(Int,Int)] getRationalValues = do skip offset replicateM comps getRationalValue getRationalValue :: Get (Int, Int) getRationalValue = do num <- getWord32 encoding denum <- getWord32 encoding return (fromIntegral num, fromIntegral denum) -- | Convert a Word16 number to an Maybe DirTag toDirTag :: Word16 -> Maybe DirTag toDirTag t | t == 0x8769 = Just IFDExif | t == 0xa005 = Just IFDInterop | t == 0x8825 = Just IFDGPS | otherwise = Nothing -- | Convert a directory tag to a number dirTagToWord16 :: DirTag -> Word16 dirTagToWord16 IFDMain = 0xFF01 dirTagToWord16 IFDExif = 0xFF02 dirTagToWord16 IFDInterop = 0xFF03 dirTagToWord16 IFDGPS = 0xFF04 -- | Convert a Word16 number together with its directory tag to an Exif Tag. toExifTag :: DirTag -> Word16 -> ExifTag toExifTag IFDGPS tg = toGPSTag tg toExifTag _ tg = toStdTag tg -- | Convert a Word16 number to standard Exif tag. toStdTag :: Word16 -> ExifTag toStdTag t = case t of 0x0001 -> TagInteroperabilityIndex 0x0002 -> TagInteroperabilityVersion 0x0100 -> TagImageWidth 0x0101 -> TagImageLength 0x0102 -> TagBitsPerSample 0x0103 -> TagCompression 0x0106 -> TagPhotometricInterpretation 0x010e -> TagImageDescription 0x010f -> TagMake 0x0110 -> TagModel 0x0112 -> TagOrientation 0x0115 -> TagSamplesPerPixel 0x011a -> TagXResolution 0x011b -> TagYResolution 0x0128 -> TagResolutionUnit 0x0131 -> TagSoftware 0x0132 -> TagDateTime 0x013b -> TagArtist 0x013c -> TagHostComputer 0x013e -> TagWhitePoint 0x013f -> TagPrimaryChromaticities 0x0201 -> TagJPEGInterchangeFormat 0x0202 -> TagJPEGInterchangeFormatLength 0x0211 -> TagYCbCrCoefficients 0x0213 -> TagYCbCrPositioning 0x0214 -> TagReferenceBlackWhite 0x1001 -> TagRelatedImageWidth 0x1002 -> TagRelatedImageLength 0x8298 -> TagCopyright 0x829a -> TagExposureTime 0x829d -> TagFNumber 0x8822 -> TagExposureProgram 0x8827 -> TagISOSpeedRatings 0x8830 -> TagSensitivityType 0x9000 -> TagExifVersion 0x9003 -> TagDateTimeOriginal 0x9004 -> TagDateTimeDigitized 0x9101 -> TagComponentsConfiguration 0x9102 -> TagCompressedBitsPerPixel 0x9201 -> TagShutterSpeedValue 0x9202 -> TagApertureValue 0x9203 -> TagBrightnessValue 0x9204 -> TagExposureBiasValue 0x9205 -> TagMaxApertureValue 0x9206 -> TagSubjectDistance 0x9207 -> TagMeteringMode 0x9208 -> TagLightSource 0x9209 -> TagFlash 0x920a -> TagFocalLength 0x927c -> TagMakerNote 0x9286 -> TagUserComment 0x9290 -> TagSubsecTime 0x9291 -> TagSubSecTimeOriginal 0x9292 -> TagSubSecTimeDigitized 0x9c9b -> TagXPTitle 0x9c9d -> TagXPAuthor 0xa000 -> TagFlashPixVersion 0xa001 -> TagColorSpace 0xa002 -> TagPixelXDimension 0xa003 -> TagPixelYDimension 0xa20e -> TagFocalPlaneXResolution 0xa20f -> TagFocalPlaneYResolution 0xa210 -> TagFocalPlaneResolutionUnit 0xa217 -> TagSensingMethod 0xa300 -> TagFileSource 0xa301 -> TagSceneType 0xa302 -> TagCFAPattern 0xa401 -> TagCustomRendered 0xa402 -> TagExposureMode 0xa403 -> TagWhiteBalance 0xa404 -> TagDigitalZoomRatio 0xa405 -> TagFocalLengthIn35mmFilm 0xa406 -> TagSceneCaptureType 0xa407 -> TagGainControl 0xa408 -> TagContrast 0xa409 -> TagSaturation 0xa40a -> TagSharpness 0xa40c -> TagSubjectDistanceRange 0xa420 -> TagImageUniqueID 0xa500 -> TagGamma 0xc4a5 -> TagPrintImageMatching 0xc6d2 -> TagPanasonicTitle1 0xc6d3 -> TagPanasonicTitle2 0xea1c -> TagPadding 0xea1d -> TagOffsetSchemata 0xff01 -> TagSubDirIFDMain 0xff02 -> TagSubDirIFDExif 0xff03 -> TagSubDirIFDInterop _ -> TagTagUnknown t -- | Convert a Word16 number to an GPS tag toGPSTag :: Word16 -> ExifTag toGPSTag t = case t of 0x0000 -> TagGPSVersionID 0x0001 -> TagGPSLatitudeRef 0x0002 -> TagGPSLatitude 0x0003 -> TagGPSLongitudeRef 0x0004 -> TagGPSLongitude 0x0005 -> TagGPSAltitudeRef 0x0006 -> TagGPSAltitude 0x0007 -> TagGPSTimeStamp 0x0010 -> TagGPSImgDirectionRef 0x0011 -> TagGPSImgDirection 0x0012 -> TagGPSMapDatum 0x0013 -> TagGPSDestLatitudeRef 0x0014 -> TagGPSDestLatitude 0x0015 -> TagGPSDestLongitudeRef 0x0016 -> TagGPSDestLongitude 0x001d -> TagGPSDateStamp 0xff04 -> TagSubDirIFDGPS _ -> TagTagUnknown t