diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -17,43 +17,120 @@ -- * The ExifValue type ExifValue(..), - -- * All known exif tags + -- * Most useful exif tags exposureTime, fnumber, - exposureProgram, isoSpeedRatings, - exifVersion, dateTimeOriginal, - dateTimeDigitized, - componentConfiguration, - compressedBitsPerPixel, shutterSpeedValue, apertureValue, brightnessValue, exposureBiasValue, maxApertureValue, - subjectDistance, - meteringMode, - lightSource, flash, focalLength, - makerNote, userComment, - colorSpace, + orientation, + make, + model, + software, + copyright, + digitalZoomRatio, + focalLengthIn35mmFilm, + artist, + + -- * GPS related exif tags + + gpsVersionID, + gpsLatitudeRef, + gpsLatitude, + gpsLongitudeRef, + gpsLongitude, + gpsAltitudeRef, + gpsAltitude, + gpsTimeStamp, + gpsSatellites, + gpsStatus, + gpsMeasureMode, + gpsDop, + gpsSpeedRef, + gpsSpeed, + gpsTrackRef, + gpsTrack, + gpsImgDirectionRef, + gpsImgDirection, + gpsMapDatum, + gpsDestLatitudeRef, + gpsDestLatitude, + gpsDestLongitudeRef, + gpsDestLongitude, + gpsDestBearingRef, + gpsDestBearing, + gpsDestDistanceRef, + gpsDestDistance, + gpsProcessingMethod, + gpsAreaInformation, + gpsDateStamp, + gpsDifferential, + + -- * Less useful exif tags + + exifVersion, + sensingMethod, + fileSource, + sceneType, + makerNote, + subjectDistance, + meteringMode, + lightSource, exifImageWidth, exifImageHeight, relatedSoundFile, focalPlaneXResolution, focalPlaneYResolution, focalPlaneResolutionUnit, - sensingMethod, - fileSource, - sceneType, - orientation, - make, - model, - software, - copyright, + dateTimeDigitized, + componentConfiguration, + compressedBitsPerPixel, + exposureProgram, + spectralSensitivity, + oecf, + subjectArea, + subSecTime, + subSecTimeOriginal, + subSecTimeDigitized, + flashPixVersion, + colorSpace, + flashEnergy, + spatialFrequencyResponse, + subjectLocation, + exposureIndex, + cfaPattern, + customRendered, + exposureMode, + whiteBalance, + sceneCaptureType, + gainControl, + contrast, + saturation, + sharpness, + deviceSettingDescription, + subjectDistanceRange, + imageUniqueId, + exifInteroperabilityOffset, + imageDescription, + xResolution, + yResolution, + resolutionUnit, + dateTime, + whitePoint, + primaryChromaticities, + yCbCrPositioning, + yCbCrCoefficients, + referenceBlackWhite, + exifIfdOffset, + printImageMatching, + gpsTagOffset, -- * If you need to declare your own exif tags ExifTag(..), @@ -61,29 +138,28 @@ ) where import Data.Binary.Get +import Data.Binary.Put import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString as BS import Control.Monad (liftM, unless) import qualified Data.ByteString.Char8 as Char8 import Data.Word import Data.Char (isDigit, ord, chr) -import Data.Int (Int32) +import Data.Int (Int32, Int16, Int8) import Data.List -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, fromJust) -- TODO try to get rid of fromJust import qualified Data.Map as Map import Data.Map (Map) import Data.Time.LocalTime import Data.Time.Calendar import Numeric (showHex) --- | An exif value. Exif values can also be float, --- but this library doesn't support it yet. If you --- have JPG files containing float exif values, --- please send it! --- +-- | An exif value. +-- -- If you want a string describing the contents -- of the value, simply use 'show'. -data ExifValue = ExifNumber Int - -- ^ An exif number. Could be short, int, signed or not. +data ExifValue = ExifNumber !Int + -- ^ An exif number. Originally it could have been short, int, signed or not. | ExifText !String -- ^ ASCII text. | ExifRational !Int !Int @@ -91,18 +167,38 @@ -- Sometimes we're used to it as rational (exposition time: 1/160), -- sometimes as float (exposure compensation, we rather think -0.75) -- 'show' will display it as 1/160. - | ExifUnknown !Word16 !Int -- type then value - -- ^ Unknown exif value type. Maybe float? If the JPEG file is not - -- corrupted, please send it to me. + | ExifNumberList ![Int] + -- ^ List of numbers. Originally they could have been short, int, signed or not. + | ExifRationalList ![(Int,Int)] + -- ^ A list of rational numbers (numerator, denominator). + -- Sometimes we're used to it as rational (exposition time: 1/160), + -- sometimes as float (exposure compensation, we rather think -0.75) + -- 'show' will display it as 1/160. + | ExifUndefined !BS.ByteString + -- ^ The undefined type in EXIF means that the contents are not + -- specified and up to the manufacturer. In effect it's exactly + -- a bytestring. Sometimes it's text with ASCII or UNICODE at the + -- beginning, often it's binary in nature. + | ExifUnknown !Word16 !Int !Int + -- ^ Unknown exif value type. All EXIF 2.3 types are + -- supported, it could be a newer file. + -- The parameters are type, count then value deriving Eq instance Show ExifValue where show (ExifNumber v) = show v show (ExifText v) = v show (ExifRational n d) = show n ++ "/" ++ show d - show (ExifUnknown t v) = show "Unknown exif type. Type: " ++ show t ++ " value: " ++ show v + show (ExifUnknown t c v) = show "Unknown exif type. Type: " ++ show t + ++ " count: " ++ show c ++ " value: " ++ show v + show (ExifNumberList l) = show l + show (ExifRationalList l) = show l + show (ExifUndefined bs) = show bs -- see http://www.media.mit.edu/pia/Research/deepview/exif.html +-- and http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf +-- and http://www.awaresystems.be/imaging/tiff/tifftags/privateifd/exif.html +-- and http://www.exiv2.org/tags.html -- | Read EXIF data from the file you give. It's a key-value map. parseFileExif :: FilePath -> IO (Either String (Map ExifTag ExifValue)) @@ -142,6 +238,10 @@ getWord32 Intel = getWord32le getWord32 Motorola = getWord32be +putWord32 :: ByteAlign -> (Word32 -> Put) +putWord32 Intel = putWord32le +putWord32 Motorola = putWord32be + parseExifBlock :: Get (Map ExifTag ExifValue) parseExifBlock = do header <- getByteString 4 @@ -150,14 +250,24 @@ $ fail "invalid EXIF header" tiffHeaderStart <- liftM fromIntegral bytesRead byteAlign <- parseTiffHeader - (exifSubIfdOffsetW, ifdEntries) <- parseIfd byteAlign tiffHeaderStart + (exifSubIfdOffsetW, mGpsOffsetW, ifdEntries) <- parseIfd byteAlign tiffHeaderStart let exifSubIfdOffset = fromIntegral $ toInteger exifSubIfdOffsetW + gpsData <- case mGpsOffsetW of + Nothing -> return [] + Just gpsOffsetW -> lookAhead $ parseGps gpsOffsetW byteAlign tiffHeaderStart -- skip to the exif offset bytesReadNow <- liftM fromIntegral bytesRead skip $ (exifSubIfdOffset + tiffHeaderStart) - bytesReadNow - exifSubEntries <- parseExifSubIfd byteAlign tiffHeaderStart - return $ Map.fromList $ ifdEntries ++ exifSubEntries + exifSubEntries <- parseSubIfd byteAlign tiffHeaderStart ExifSubIFD + return $ Map.fromList $ ifdEntries ++ exifSubEntries ++ gpsData +parseGps :: Word32 -> ByteAlign -> Int -> Get [(ExifTag, ExifValue)] +parseGps gpsOffsetW byteAlign tiffHeaderStart = do + let gpsOffset = fromIntegral $ toInteger gpsOffsetW + bytesReadNow <- liftM fromIntegral bytesRead + skip $ (gpsOffset + tiffHeaderStart) - bytesReadNow + parseSubIfd byteAlign tiffHeaderStart GpsSubIFD + parseTiffHeader :: Get ByteAlign parseTiffHeader = do byteAlignV <- getByteString 2 @@ -172,27 +282,30 @@ skip $ ifdOffset - 8 return byteAlign -parseIfd :: ByteAlign -> Int -> Get (Word32, [(ExifTag, ExifValue)]) +parseIfd :: ByteAlign -> Int -> Get (Word32, Maybe Word32, [(ExifTag, ExifValue)]) parseIfd byteAlign tiffHeaderStart = do dirEntriesCount <- liftM toInteger (getWord16 byteAlign) ifdEntries <- mapM (\_ -> parseIfEntry byteAlign) [1..dirEntriesCount] - let exifOffsetEntry = fromMaybe (error "Can't find the exif offset in the IFD") - (find (\ e -> entryTag e == 0x8769) ifdEntries) + let exifOffsetEntry = fromMaybe (error "Can't find the exif ifd offset") + (find (\ e -> entryTag e == tagKey exifIfdOffset) ifdEntries) let exifOffset = entryContents exifOffsetEntry + + let gpsOffsetEntry = find (\ e -> entryTag e == tagKey gpsTagOffset) ifdEntries + let gpsOffset = fmap entryContents gpsOffsetEntry entries <- mapM (decodeEntry byteAlign tiffHeaderStart IFD0) ifdEntries - return (exifOffset, entries) + return (exifOffset, gpsOffset, entries) -parseExifSubIfd :: ByteAlign -> Int -> Get [(ExifTag, ExifValue)] -parseExifSubIfd byteAlign tiffHeaderStart = do +parseSubIfd :: ByteAlign -> Int -> TagLocation -> Get [(ExifTag, ExifValue)] +parseSubIfd byteAlign tiffHeaderStart location = do dirEntriesCount <- liftM toInteger (getWord16 byteAlign) ifdEntries <- mapM (\_ -> parseIfEntry byteAlign) [1..dirEntriesCount] - mapM (decodeEntry byteAlign tiffHeaderStart ExifSubIFD) ifdEntries + mapM (decodeEntry byteAlign tiffHeaderStart location) ifdEntries data IfEntry = IfEntry { entryTag :: !Word16, entryFormat :: !Word16, - entryNoComponents :: !Word32, + entryNoComponents :: !Int, entryContents :: !Word32 } deriving Show @@ -206,7 +319,7 @@ { entryTag = tagNumber, entryFormat = dataFormat, - entryNoComponents = numComponents, + entryNoComponents = fromIntegral $ toInteger numComponents, entryContents = value } @@ -216,7 +329,7 @@ -- exif tag you're interested in. -- Rather check the list of supported exif tags, like -- 'exposureTime' and so on. -data TagLocation = ExifSubIFD | IFD0 +data TagLocation = ExifSubIFD | IFD0 | GpsSubIFD deriving (Show, Eq, Ord) -- | An exif tag. Normally you don't need to fiddle with this, @@ -248,95 +361,319 @@ exifIfd0Tag :: String -> Word16 -> ExifTag exifIfd0Tag d = ExifTag IFD0 (Just d) +exifGpsTag :: String -> Word16 -> ExifTag +exifGpsTag d = ExifTag GpsSubIFD (Just d) + exposureTime = exifSubIfdTag "exposureTime" 0x829a fnumber = exifSubIfdTag "fnumber" 0x829d exposureProgram = exifSubIfdTag "exposureProgram" 0x8822 -isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 -exifVersion = exifSubIfdTag "exifVersion" 0x9000 -dateTimeOriginal = exifSubIfdTag "dateTimeOriginal" 0x9003 -dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 -componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 -compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 -shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 -apertureValue = exifSubIfdTag "apertureValue" 0x9202 -brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 -exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 -maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 -subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 -meteringMode = exifSubIfdTag "meteringMode" 0x9207 -lightSource = exifSubIfdTag "lightSource" 0x9208 -flash = exifSubIfdTag "flash" 0x9209 -focalLength = exifSubIfdTag "focalLength" 0x920a -makerNote = exifSubIfdTag "makerNote" 0x927c -userComment = exifSubIfdTag "userComment" 0x9286 -colorSpace = exifSubIfdTag "colorSpace" 0xa001 -exifImageWidth = exifSubIfdTag "exifImageWidth" 0xa002 -exifImageHeight = exifSubIfdTag "exifImageHeight" 0xa003 -relatedSoundFile = exifSubIfdTag "relatedSoundFile" 0xa004 -focalPlaneXResolution = exifSubIfdTag "focalPlaneXResolution" 0xa20e -focalPlaneYResolution = exifSubIfdTag "focalPlaneYResolution" 0xa20f -focalPlaneResolutionUnit= exifSubIfdTag "focalPlaneResolutionUnit" 0xa210 -sensingMethod = exifSubIfdTag "sensingMethod" 0xa217 -fileSource = exifSubIfdTag "fileSource" 0xa300 -sceneType = exifSubIfdTag "sceneType" 0xa301 -orientation = exifIfd0Tag "orientation" 0x0112 -make = exifIfd0Tag "make" 0x010f -model = exifIfd0Tag "model" 0x0110 -software = exifIfd0Tag "software" 0x0131 -copyright = exifIfd0Tag "copyright" 0x8298 +spectralSensitivity = exifSubIfdTag "spectralSensitivity" 0x8824 +isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 +oecf = exifSubIfdTag "OECF" 0x8828 +exifVersion = exifSubIfdTag "exifVersion" 0x9000 +dateTimeOriginal = exifSubIfdTag "dateTimeOriginal" 0x9003 +dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 +componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 +compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 +shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 +apertureValue = exifSubIfdTag "apertureValue" 0x9202 +brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 +exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 +maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 +subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 +meteringMode = exifSubIfdTag "meteringMode" 0x9207 +lightSource = exifSubIfdTag "lightSource" 0x9208 +flash = exifSubIfdTag "flash" 0x9209 +focalLength = exifSubIfdTag "focalLength" 0x920a +subjectArea = exifSubIfdTag "subjectArea" 0x9214 +makerNote = exifSubIfdTag "makerNote" 0x927c +userComment = exifSubIfdTag "userComment" 0x9286 +subSecTime = exifSubIfdTag "subSecTime" 0x9290 +subSecTimeOriginal = exifSubIfdTag "subSecTimeOriginal" 0x9291 +subSecTimeDigitized = exifSubIfdTag "subSecTimeDigitized" 0x9292 +flashPixVersion = exifSubIfdTag "flashPixVersion" 0xa000 +colorSpace = exifSubIfdTag "colorSpace" 0xa001 +exifImageWidth = exifSubIfdTag "exifImageWidth" 0xa002 +exifImageHeight = exifSubIfdTag "exifImageHeight" 0xa003 +relatedSoundFile = exifSubIfdTag "relatedSoundFile" 0xa004 +flashEnergy = exifSubIfdTag "flashEnergy" 0xa20b +spatialFrequencyResponse= exifSubIfdTag "spatialFrequencyResponse" 0xa20c +focalPlaneXResolution = exifSubIfdTag "focalPlaneXResolution" 0xa20e +focalPlaneYResolution = exifSubIfdTag "focalPlaneYResolution" 0xa20f +focalPlaneResolutionUnit= exifSubIfdTag "focalPlaneResolutionUnit" 0xa210 +subjectLocation = exifSubIfdTag "subjectLocation" 0xa214 +exposureIndex = exifSubIfdTag "exposureIndex" 0xa215 +sensingMethod = exifSubIfdTag "sensingMethod" 0xa217 +fileSource = exifSubIfdTag "fileSource" 0xa300 +sceneType = exifSubIfdTag "sceneType" 0xa301 +cfaPattern = exifSubIfdTag "cfaPattern" 0xa302 +customRendered = exifSubIfdTag "customRendered" 0xa401 +exposureMode = exifSubIfdTag "exposureMode" 0xa402 +whiteBalance = exifSubIfdTag "whiteBalance" 0xa403 +digitalZoomRatio = exifSubIfdTag "digitalZoomRatio" 0xa404 +focalLengthIn35mmFilm = exifSubIfdTag "focalLengthIn35mmFilm" 0xa405 +sceneCaptureType = exifSubIfdTag "sceneCaptureType" 0xa406 +gainControl = exifSubIfdTag "gainControl" 0xa407 +contrast = exifSubIfdTag "contrast" 0xa408 +saturation = exifSubIfdTag "saturation" 0xa409 +sharpness = exifSubIfdTag "sharpness" 0xa40a +deviceSettingDescription= exifSubIfdTag "deviceSettingDescription" 0xa40b +subjectDistanceRange = exifSubIfdTag "subjectDistanceRange" 0xa40c +imageUniqueId = exifSubIfdTag "imageUniqueId" 0xa420 +exifInteroperabilityOffset=exifSubIfdTag "exifInteroperabilityOffset" 0xa005 +imageDescription = exifIfd0Tag "imageDescription" 0x010e +make = exifIfd0Tag "make" 0x010f +model = exifIfd0Tag "model" 0x0110 +orientation = exifIfd0Tag "orientation" 0x0112 +xResolution = exifIfd0Tag "xResolution" 0x011a +yResolution = exifIfd0Tag "xResolution" 0x011b +resolutionUnit = exifIfd0Tag "resolutionUnit" 0x0128 +software = exifIfd0Tag "software" 0x0131 +dateTime = exifIfd0Tag "dateTime" 0x0132 +artist = exifIfd0Tag "artist" 0x013b +whitePoint = exifIfd0Tag "whitePoint" 0x013e +primaryChromaticities = exifIfd0Tag "primaryChromaticities" 0x013f +yCbCrCoefficients = exifIfd0Tag "yCbCrCoefficients" 0x0211 +yCbCrPositioning = exifIfd0Tag "yCbCrPositioning" 0x0213 +referenceBlackWhite = exifIfd0Tag "referenceBlackWhite" 0x0214 +copyright = exifIfd0Tag "copyright" 0x8298 +exifIfdOffset = exifIfd0Tag "exifIfdOffset" 0x8769 +gpsTagOffset = exifIfd0Tag "gpsTagOffset" 0x8825 +printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 + +gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 +gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 +gpsLatitude = exifGpsTag "gpsLatitude" 0x0002 +gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 +gpsLongitude = exifGpsTag "gpsLongitude" 0x0004 +gpsAltitudeRef = exifGpsTag "gpsAltitudeRef" 0x0005 +gpsAltitude = exifGpsTag "gpsAltitude" 0x0006 +gpsTimeStamp = exifGpsTag "gpsTimeStamp" 0x0007 +gpsSatellites = exifGpsTag "gpsSatellites" 0x0008 +gpsStatus = exifGpsTag "gpsStatus" 0x0009 +gpsMeasureMode = exifGpsTag "gpsMeasureMode" 0x000a +gpsDop = exifGpsTag "gpsDop" 0x000b +gpsSpeedRef = exifGpsTag "gpsSpeedRef" 0x000c +gpsSpeed = exifGpsTag "gpsSpeed" 0x000d +gpsTrackRef = exifGpsTag "gpsTrackRef" 0x000e +gpsTrack = exifGpsTag "gpsTrack" 0x000f +gpsImgDirectionRef= exifGpsTag "gpsImgDirectionRef" 0x0010 +gpsImgDirection = exifGpsTag "gpsImgDirection" 0x0011 +gpsMapDatum = exifGpsTag "gpsMapDatum" 0x0012 +gpsDestLatitudeRef= exifGpsTag "gpsDestLatitudeRef" 0x0013 +gpsDestLatitude = exifGpsTag "gpsDestLatitude" 0x0014 +gpsDestLongitudeRef= exifGpsTag "gpsDestLongitudeRef" 0x0015 +gpsDestLongitude= exifGpsTag "gpsDestLongitude" 0x0016 +gpsDestBearingRef= exifGpsTag "gpsDestBearingRef" 0x0017 +gpsDestBearing = exifGpsTag "gpsDestBearing" 0x0018 +gpsDestDistanceRef= exifGpsTag "gpsDestDistanceRef" 0x0019 +gpsDestDistance = exifGpsTag "gpsDestDistance" 0x001a +gpsProcessingMethod= exifGpsTag "gpsProcessingMethod" 0x001b +gpsAreaInformation= exifGpsTag "gpsAreaInformation" 0x001c +gpsDateStamp = exifGpsTag "gpsDateStamp" 0x001d +gpsDifferential = exifGpsTag "gpsDifferential" 0x001e + allExifTags :: [ExifTag] allExifTags = [exposureTime, fnumber, exposureProgram, isoSpeedRatings, exifVersion, dateTimeOriginal, dateTimeDigitized, componentConfiguration, compressedBitsPerPixel, shutterSpeedValue, apertureValue, brightnessValue, exposureBiasValue, maxApertureValue, subjectDistance, meteringMode, - lightSource, flash, focalLength, makerNote, userComment, colorSpace, + lightSource, flash, focalLength, makerNote, userComment, exifImageWidth, exifImageHeight, relatedSoundFile, focalPlaneXResolution, focalPlaneYResolution, focalPlaneResolutionUnit, sensingMethod, fileSource, - sceneType, orientation, make, model, software, copyright] + sceneType, orientation, make, model, software, copyright, + spectralSensitivity, oecf, subjectArea, subSecTime, subSecTimeOriginal, + subSecTimeDigitized, flashPixVersion, colorSpace, flashEnergy, + spatialFrequencyResponse, subjectLocation, exposureIndex, cfaPattern, + customRendered, exposureMode, whiteBalance, digitalZoomRatio, + focalLengthIn35mmFilm, sceneCaptureType, gainControl, contrast, + saturation, sharpness, deviceSettingDescription, subjectDistanceRange, + imageUniqueId, exifInteroperabilityOffset, imageDescription, + xResolution, yResolution, resolutionUnit, dateTime, whitePoint, + primaryChromaticities, yCbCrPositioning, yCbCrCoefficients, referenceBlackWhite, + exifIfdOffset, printImageMatching, gpsTagOffset, artist, + gpsVersionID, gpsLatitudeRef, gpsLatitude, gpsLongitudeRef, gpsLongitude, + gpsAltitudeRef, gpsAltitude, gpsTimeStamp, gpsSatellites, gpsStatus, + gpsMeasureMode, gpsDop, gpsSpeedRef, gpsSpeed, gpsTrackRef, gpsTrack, + gpsImgDirectionRef, gpsImgDirection, gpsMapDatum, gpsDestLatitudeRef, + gpsDestLatitude, gpsDestLongitudeRef, gpsDestLongitude, gpsDestBearingRef, + gpsDestBearing, gpsDestDistanceRef, gpsDestDistance, gpsProcessingMethod, + gpsAreaInformation, gpsDateStamp, gpsDifferential] getExifTag :: TagLocation -> Word16 -> ExifTag getExifTag l v = fromMaybe (ExifTag l Nothing v) $ find (isSameTag l v) allExifTags where isSameTag l1 v1 (ExifTag l2 _ v2) = l1 == l2 && v1 == v2 +data ValueHandler = ValueHandler + { + dataTypeId :: Word16, + dataLength :: Int, + readSingle :: ByteAlign -> Get ExifValue, + readMany :: ByteAlign -> Int -> Get ExifValue + } + +readNumberList decoder = \byteAlign components -> liftM (ExifNumberList . fmap fromIntegral) + $ readManyInternal byteAlign components + where readManyInternal byteAlign components = count components (decoder byteAlign) + +unsignedByteValueHandler = ValueHandler + { + dataTypeId = 1, + dataLength = 1, + readSingle = \_ -> liftM (ExifNumber . fromIntegral) getWord8, + readMany = readNumberList (\_ -> getWord8) + } + +asciiStringValueHandler = ValueHandler + { + dataTypeId = 2, + dataLength = 1, + readSingle = \ba -> readMany asciiStringValueHandler ba 1, + readMany = \_ components -> liftM (ExifText . Char8.unpack) (getByteString (components-1)) + } + +unsignedShortValueHandler = ValueHandler + { + dataTypeId = 3, + dataLength = 2, + readSingle = \byteAlign -> liftM (ExifNumber . fromIntegral) $ getWord16 byteAlign, + readMany = readNumberList getWord16 + } + +unsignedLongValueHandler = ValueHandler + { + dataTypeId = 4, + dataLength = 4, + readSingle = \byteAlign -> liftM (ExifNumber . fromIntegral) $ getWord32 byteAlign, + readMany = readNumberList getWord32 + } + +readRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a +readRationalContents c byteAlign = do + numerator <- liftM fromIntegral $ getWord32 byteAlign + denominator <- liftM fromIntegral $ getWord32 byteAlign + return $ c numerator denominator + +unsignedRationalValueHandler = ValueHandler + { + dataTypeId = 5, + dataLength = 8, + readSingle = readRationalContents ExifRational, + readMany = let readManyInternal byteAlign components = count components (readRationalContents (,) byteAlign) in + \byteAlign components -> liftM ExifRationalList $ readManyInternal byteAlign components + } + +signedByteValueHandler = ValueHandler + { + dataTypeId = 6, + dataLength = 1, + readSingle = \_ -> liftM (ExifNumber . signedInt8ToInt) getWord8, + readMany = readNumberList (\_ -> liftM signedInt8ToInt getWord8) + } + +undefinedValueHandler = ValueHandler + { + dataTypeId = 7, + dataLength = 1, + readSingle = \ba -> readMany undefinedValueHandler ba 1, + readMany = \_ components -> liftM ExifUndefined (getByteString (components-1)) + } + +signedShortValueHandler = ValueHandler + { + dataTypeId = 8, + dataLength = 2, + readSingle = \byteAlign -> liftM (ExifNumber . signedInt16ToInt) $ getWord16 byteAlign, + readMany = readNumberList (\b -> liftM signedInt16ToInt $ getWord16 b) + } + +signedLongValueHandler = ValueHandler + { + dataTypeId = 9, + dataLength = 4, + readSingle = \byteAlign -> liftM (ExifNumber . signedInt32ToInt) $ getWord32 byteAlign, + readMany = readNumberList (\b -> liftM signedInt32ToInt $ getWord32 b) + } + +readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a +readSignedRationalContents c byteAlign = do + numerator <- liftM signedInt32ToInt $ getWord32 byteAlign + denominator <- liftM signedInt32ToInt $ getWord32 byteAlign + return $ c numerator denominator + +signedRationalValueHandler = ValueHandler + { + dataTypeId = 10, + dataLength = 8, + readSingle = readSignedRationalContents ExifRational, + readMany = let readManyInternal byteAlign components = count components (readSignedRationalContents (,) byteAlign) in + \byteAlign components -> liftM ExifRationalList $ readManyInternal byteAlign components + } + +-- ascii string is special for now. +valueHandlers :: [ValueHandler] +valueHandlers = + [ + unsignedByteValueHandler, + asciiStringValueHandler, + unsignedShortValueHandler, + unsignedLongValueHandler, + unsignedRationalValueHandler, + signedByteValueHandler, + signedShortValueHandler, + signedLongValueHandler, + signedRationalValueHandler, + undefinedValueHandler + ] + decodeEntry :: ByteAlign -> Int -> TagLocation -> IfEntry -> Get (ExifTag, ExifValue) decodeEntry byteAlign tiffHeaderStart location entry = do let exifTag = getExifTag location $ entryTag entry let contentsInt = fromIntegral $ toInteger $ entryContents entry - let componentsInt = fromIntegral $ toInteger $ entryNoComponents entry -- because I only know how to skip ahead, I hope the entries -- are always sorted in order of the offsets to their values... -- (maybe lookAhead could help here?) - tagValue <- case entryFormat entry of - 1 -> return $ ExifNumber contentsInt -- unsigned byte - 2 -> do -- ascii string - curPos <- liftM fromIntegral bytesRead - skip $ contentsInt + tiffHeaderStart - curPos - liftM (ExifText . Char8.unpack) (getByteString (componentsInt-1)) - 3 -> return $ ExifNumber contentsInt -- unsigned short - 4 -> return $ ExifNumber contentsInt -- unsigned long - 5 -> do -- unsigned rational - curPos <- liftM fromIntegral bytesRead - skip $ contentsInt + tiffHeaderStart - curPos - numerator <- liftM fromIntegral $ getWord32 byteAlign - denominator <- liftM fromIntegral $ getWord32 byteAlign - return $ ExifRational numerator denominator - 6 -> return $ ExifNumber $ signedInt32ToInt $ entryContents entry -- signed byte - 7 -> return $ ExifNumber contentsInt -- undefined - 8 -> return $ ExifNumber $ signedInt32ToInt $ entryContents entry -- signed short - 9 -> return $ ExifNumber $ signedInt32ToInt $ entryContents entry -- signed long - 10 -> do -- signed rational - curPos <- liftM fromIntegral bytesRead - skip $ contentsInt + tiffHeaderStart - curPos - numerator <- liftM signedInt32ToInt (getWord32 byteAlign) - denominator <- liftM signedInt32ToInt (getWord32 byteAlign) - return $ ExifRational numerator denominator - -- TODO decode float values, 11 single float and 12 double float but I'd like tests - _ -> return $ ExifUnknown (entryFormat entry) contentsInt + tagValue <- case getHandler $ entryFormat entry of + Just handler -> decodeEntryWithHandler byteAlign tiffHeaderStart handler entry + Nothing -> return $ ExifUnknown (entryFormat entry) (entryNoComponents entry) contentsInt return (exifTag, tagValue) +getHandler :: Word16 -> Maybe ValueHandler +getHandler typeId = find ((==typeId) . dataTypeId) valueHandlers + +decodeEntryWithHandler :: ByteAlign -> Int -> ValueHandler -> IfEntry -> Get ExifValue +decodeEntryWithHandler byteAlign tiffHeaderStart handler entry = do + if dataLength handler * (entryNoComponents entry) <= 4 + then return $ parseInline byteAlign handler entry inlineBs + else parseOffset byteAlign tiffHeaderStart handler entry + where + inlineBs = runPut $ putWord32 byteAlign $ entryContents entry + +parseInline :: ByteAlign -> ValueHandler -> IfEntry -> B.ByteString -> ExifValue +parseInline byteAlign handler entry bytestring = + fromJust $ runMaybeGet getter bytestring + where + getter = case entryNoComponents entry of + 1 -> readSingle handler byteAlign + _ -> readMany handler byteAlign $ entryNoComponents entry + +parseOffset :: ByteAlign -> Int -> ValueHandler -> IfEntry -> Get ExifValue +parseOffset byteAlign tiffHeaderStart handler entry = do + let contentsInt = fromIntegral $ toInteger $ entryContents entry + curPos <- liftM fromIntegral bytesRead + skip $ contentsInt + tiffHeaderStart - curPos + bytestring <- getLazyByteString (fromIntegral $ entryNoComponents entry * dataLength handler) + return $ parseInline byteAlign handler entry bytestring + signedInt32ToInt :: Word32 -> Int signedInt32ToInt w = fromIntegral (fromIntegral w :: Int32) + +signedInt16ToInt :: Word16 -> Int +signedInt16ToInt w = fromIntegral (fromIntegral w :: Int16) + +signedInt8ToInt :: Word8 -> Int +signedInt8ToInt w = fromIntegral (fromIntegral w :: Int8) -- i had this as runGetM and reusing in parseExif, -- sadly fail is not implemented for Either. diff --git a/hsexif.cabal b/hsexif.cabal --- a/hsexif.cabal +++ b/hsexif.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hsexif -version: 0.3.0.0 +version: 0.4.0.0 synopsis: EXIF handling library in pure Haskell description: The hsexif library provides functions for working with EXIF data contained in JPEG files. Currently it only supports reading the data. diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,13 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} import Test.Hspec import Test.HUnit import Graphics.HsExif import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString as BS import qualified Data.Map as Map import Data.Map (Map) import Data.Time.LocalTime import Data.Time.Calendar -import Data.Word +import Data.Char (chr) main :: IO () main = do @@ -33,61 +35,64 @@ assertEqual' (Left "No EXIF in JPEG") (parseExif imageContents) testBasic :: B.ByteString -> Spec -testBasic imageContents = it "parses a simple JPEG" $ - assertEqual' (Right $ Map.fromList [ - (exposureTime, ExifRational 1 160), - (fnumber, ExifRational 0 10), - (exposureProgram, ExifNumber 2), - (isoSpeedRatings, ExifNumber 1600), - (exifVersion, ExifNumber 808661552), - (dateTimeOriginal, ExifText "2013:10:02 20:33:33"), - (dateTimeDigitized, ExifText "2013:10:02 20:33:33"), - (componentConfiguration, ExifNumber 197121), - (compressedBitsPerPixel, ExifRational 2 1), - (brightnessValue, ExifRational (-4226) 2560), - (exposureBiasValue, ExifRational 0 10), - (maxApertureValue, ExifRational 0 10), - (meteringMode, ExifNumber 5), - (lightSource, ExifNumber 0), - (fileSource, ExifNumber 3), - (flash, ExifNumber 24), - (focalLength, ExifRational 0 10), - (makerNote, ExifNumber 868), - (userComment, ExifNumber 36568), - (unknownExifSubIfdTag 40960, ExifNumber 808464688), - (colorSpace, ExifNumber 1), - (sceneType, ExifNumber 1), - (exifImageWidth, ExifNumber 1), - (exifImageHeight, ExifNumber 1), - (unknownExifSubIfdTag 40965, ExifNumber 36640), - (unknownExifSubIfdTag 41985, ExifNumber 0), - (unknownExifSubIfdTag 41986, ExifNumber 0), - (unknownExifSubIfdTag 41987, ExifNumber 0), - (unknownExifSubIfdTag 41988, ExifRational 16 16), - (unknownExifSubIfdTag 41989, ExifNumber 0), - (unknownExifSubIfdTag 41990, ExifNumber 0), - (unknownExifSubIfdTag 41992, ExifNumber 0), - (unknownExifSubIfdTag 41993, ExifNumber 0), - (unknownExifSubIfdTag 41994, ExifNumber 0), - (make, ExifText "SONY"), - (model, ExifText "NEX-3N"), - (software, ExifText "GIMP 2.8.10"), - (orientation, ExifNumber 1), - (unknownExifIfd0Tag 0x10e, ExifText " "), - (unknownExifIfd0Tag 0x11a, ExifRational 350 1), - (unknownExifIfd0Tag 0x11b, ExifRational 350 1), - (unknownExifIfd0Tag 0x128, ExifNumber 2), - (unknownExifIfd0Tag 0x132, ExifText "2014:04:10 20:14:20"), - (unknownExifIfd0Tag 0x213, ExifNumber 2), - (unknownExifIfd0Tag 0x8769, ExifNumber 358), - (unknownExifIfd0Tag 0xc4a5, ExifNumber 252) - ]) (parseExif imageContents) - -unknownExifSubIfdTag :: Word16 -> ExifTag -unknownExifSubIfdTag = ExifTag ExifSubIFD Nothing - -unknownExifIfd0Tag :: Word16 -> ExifTag -unknownExifIfd0Tag = ExifTag IFD0 Nothing +testBasic imageContents = it "parses a simple JPEG" $ do + assertEqual' + (Map.fromList + [ + (exposureTime, ExifRational 1 160), + (fnumber, ExifRational 0 10), + (exposureProgram, ExifNumber 2), + (isoSpeedRatings, ExifNumber 1600), + (exifVersion, ExifUndefined "023"), + (dateTimeOriginal, ExifText "2013:10:02 20:33:33"), + (dateTimeDigitized, ExifText "2013:10:02 20:33:33"), + (componentConfiguration, ExifUndefined "\SOH\STX\ETX"), + (compressedBitsPerPixel, ExifRational 2 1), + (brightnessValue, ExifRational (-4226) 2560), + (exposureBiasValue, ExifRational 0 10), + (maxApertureValue, ExifRational 0 10), + (meteringMode, ExifNumber 5), + (lightSource, ExifNumber 0), + (fileSource, ExifUndefined ""), + (flash, ExifNumber 24), + (focalLength, ExifRational 0 10), + (userComment, ExifUndefined "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"), + (flashPixVersion, ExifUndefined "010"), + (colorSpace, ExifNumber 1), + (sceneType, ExifUndefined ""), + (exifImageWidth, ExifNumber 1), + (exifImageHeight, ExifNumber 1), + (exifInteroperabilityOffset, ExifNumber 36640), + (customRendered, ExifNumber 0), + (exposureMode, ExifNumber 0), + (whiteBalance, ExifNumber 0), + (digitalZoomRatio, ExifRational 16 16), + (focalLengthIn35mmFilm, ExifNumber 0), + (contrast, ExifNumber 0), + (saturation, ExifNumber 0), + (sceneCaptureType, ExifNumber 0), + (sharpness, ExifNumber 0), + (make, ExifText "SONY"), + (model, ExifText "NEX-3N"), + (software, ExifText "GIMP 2.8.10"), + (orientation, ExifNumber 1), + (imageDescription, ExifText " "), + (xResolution, ExifRational 350 1), + (yResolution, ExifRational 350 1), + (resolutionUnit, ExifNumber 2), + (dateTime, ExifText "2014:04:10 20:14:20"), + (yCbCrPositioning, ExifNumber 2), + (exifIfdOffset, ExifNumber 358), + (printImageMatching, ExifUndefined "PrintIM\NUL0300\NUL\NUL\ETX\NUL\STX\NUL\SOH\NUL\NUL\NUL\ETX\NUL\"\NUL\NUL\NUL\SOH\SOH\NUL\NUL\NUL\NUL\t\DC1\NUL\NUL\DLE'\NUL\NUL\v\SI\NUL\NUL\DLE'\NUL\NUL\151\ENQ\NUL\NUL\DLE'\NUL\NUL\176\b\NUL\NUL\DLE'\NUL\NUL\SOH\FS\NUL\NUL\DLE'\NUL\NUL^\STX\NUL\NUL\DLE'\NUL\NUL\139\NUL\NUL\NUL\DLE'\NUL\NUL\203\ETX\NUL\NUL\DLE'\NUL\NUL\229\ESC\NUL\NUL\DLE'\NUL") + ]) cleanedParsed + -- the sony maker note is 35k!! Just test its size and that it starts with "SONY DSC". + assertEqual' 35698 (BS.length makerNoteV) + assertEqual' "SONY DSC" (take 8 $ fmap (chr . fromIntegral) $ BS.unpack makerNoteV) + where + -- the makerNote is HUGE. so test it separately. + parsed = (\(Right x) -> x) $ parseExif imageContents + cleanedParsed = Map.fromList $ filter (\(a,_) -> not (a==makerNote)) $ Map.toList parsed + makerNoteV = (\(Just (ExifUndefined x)) -> x) $ Map.lookup makerNote parsed testDate :: Map ExifTag ExifValue -> Spec testDate exifData = it "extracts the date correctly" $