diff --git a/Graphics/ExifTags.hs b/Graphics/ExifTags.hs --- a/Graphics/ExifTags.hs +++ b/Graphics/ExifTags.hs @@ -35,186 +35,182 @@ showT :: Show a => a -> Text showT = T.pack . show -exposureTime = exifSubIfdTag "exposureTime" 0x829a $ withFormat "%s sec." -fnumber = exifSubIfdTag "fnumber" 0x829d $ withFormat "f/%s" -exposureProgram = exifSubIfdTag "exposureProgram" 0x8822 ppExposureProgram -spectralSensitivity = exifSubIfdTag "spectralSensitivity" 0x8824 showT -isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 showT -oecf = exifSubIfdTag "OECF" 0x8828 showT -exifVersion = exifSubIfdTag "exifVersion" 0x9000 ppExifVersion -dateTimeOriginal = exifSubIfdTag "dateTimeOriginal" 0x9003 showT -dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 showT -componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 ppComponentConfiguration -compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (T.pack . formatAsFloatingPoint 2) -shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ withFormat "%s sec." -apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppAperture -brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 $ asFpWithFormat "%s EV" -exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 $ asFpWithFormat "%s EV" -maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 ppAperture -subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 showT -meteringMode = exifSubIfdTag "meteringMode" 0x9207 ppMeteringMode -lightSource = exifSubIfdTag "lightSource" 0x9208 ppLightSource -flash = exifSubIfdTag "flash" 0x9209 ppFlash -focalLength = exifSubIfdTag "focalLength" 0x920a $ asFpWithFormat "%s mm" -subjectArea = exifSubIfdTag "subjectArea" 0x9214 showT -makerNote = exifSubIfdTag "makerNote" 0x927c ppUndef -userComment = exifSubIfdTag "userComment" 0x9286 ppUserComment -subSecTime = exifSubIfdTag "subSecTime" 0x9290 showT -subSecTimeOriginal = exifSubIfdTag "subSecTimeOriginal" 0x9291 showT -subSecTimeDigitized = exifSubIfdTag "subSecTimeDigitized" 0x9292 showT -flashPixVersion = exifSubIfdTag "flashPixVersion" 0xa000 ppFlashPixVersion -colorSpace = exifSubIfdTag "colorSpace" 0xa001 ppColorSpace -exifImageWidth = exifSubIfdTag "exifImageWidth" 0xa002 showT -exifImageHeight = exifSubIfdTag "exifImageHeight" 0xa003 showT -relatedSoundFile = exifSubIfdTag "relatedSoundFile" 0xa004 showT -flashEnergy = exifSubIfdTag "flashEnergy" 0xa20b showT +exposureTime = exifSubIfdTag "exposureTime" 0x829a $ withFormat "%s sec." +fnumber = exifSubIfdTag "fnumber" 0x829d $ withFormat "f/%s" +exposureProgram = exifSubIfdTag "exposureProgram" 0x8822 ppExposureProgram +spectralSensitivity = exifSubIfdTag "spectralSensitivity" 0x8824 showT +isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 showT +oecf = exifSubIfdTag "OECF" 0x8828 showT +exifVersion = exifSubIfdTag "exifVersion" 0x9000 ppExifVersion +dateTimeOriginal = exifSubIfdTag "dateTimeOriginal" 0x9003 showT +dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 showT +componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 ppComponentConfiguration +compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (T.pack . formatAsFloatingPoint 2) +shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ withFormat "%s sec." +apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppAperture +brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 $ asFpWithFormat "%s EV" +exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 $ asFpWithFormat "%s EV" +maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 ppAperture +subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 showT +meteringMode = exifSubIfdTag "meteringMode" 0x9207 ppMeteringMode +lightSource = exifSubIfdTag "lightSource" 0x9208 ppLightSource +flash = exifSubIfdTag "flash" 0x9209 ppFlash +focalLength = exifSubIfdTag "focalLength" 0x920a $ asFpWithFormat "%s mm" +subjectArea = exifSubIfdTag "subjectArea" 0x9214 showT +makerNote = exifSubIfdTag "makerNote" 0x927c ppUndef +userComment = exifSubIfdTag "userComment" 0x9286 ppUserComment +subSecTime = exifSubIfdTag "subSecTime" 0x9290 showT +subSecTimeOriginal = exifSubIfdTag "subSecTimeOriginal" 0x9291 showT +subSecTimeDigitized = exifSubIfdTag "subSecTimeDigitized" 0x9292 showT +flashPixVersion = exifSubIfdTag "flashPixVersion" 0xa000 ppFlashPixVersion +colorSpace = exifSubIfdTag "colorSpace" 0xa001 ppColorSpace +exifImageWidth = exifSubIfdTag "exifImageWidth" 0xa002 showT +exifImageHeight = exifSubIfdTag "exifImageHeight" 0xa003 showT +relatedSoundFile = exifSubIfdTag "relatedSoundFile" 0xa004 showT +flashEnergy = exifSubIfdTag "flashEnergy" 0xa20b showT spatialFrequencyResponse= exifSubIfdTag "spatialFrequencyResponse" 0xa20c showT -focalPlaneXResolution = exifSubIfdTag "focalPlaneXResolution" 0xa20e showT -focalPlaneYResolution = exifSubIfdTag "focalPlaneYResolution" 0xa20f showT +focalPlaneXResolution = exifSubIfdTag "focalPlaneXResolution" 0xa20e showT +focalPlaneYResolution = exifSubIfdTag "focalPlaneYResolution" 0xa20f showT focalPlaneResolutionUnit= exifSubIfdTag "focalPlaneResolutionUnit" 0xa210 ppFocalPlaneResolutionUnit -subjectLocation = exifSubIfdTag "subjectLocation" 0xa214 showT -exposureIndex = exifSubIfdTag "exposureIndex" 0xa215 showT -sensingMethod = exifSubIfdTag "sensingMethod" 0xa217 ppSensingMethod -fileSource = exifSubIfdTag "fileSource" 0xa300 ppFileSource -sceneType = exifSubIfdTag "sceneType" 0xa301 ppSceneType -cfaPattern = exifSubIfdTag "cfaPattern" 0xa302 showT -customRendered = exifSubIfdTag "customRendered" 0xa401 ppCustomRendered -exposureMode = exifSubIfdTag "exposureMode" 0xa402 ppExposureMode -whiteBalance = exifSubIfdTag "whiteBalance" 0xa403 ppWhiteBalance -digitalZoomRatio = exifSubIfdTag "digitalZoomRatio" 0xa404 showT -focalLengthIn35mmFilm = exifSubIfdTag "focalLengthIn35mmFilm" 0xa405 $ asFpWithFormat "%s mm" -sceneCaptureType = exifSubIfdTag "sceneCaptureType" 0xa406 ppSceneCaptureType -gainControl = exifSubIfdTag "gainControl" 0xa407 ppGainControl -contrast = exifSubIfdTag "contrast" 0xa408 ppContrastSharpness -saturation = exifSubIfdTag "saturation" 0xa409 ppSaturation -sharpness = exifSubIfdTag "sharpness" 0xa40a ppContrastSharpness +subjectLocation = exifSubIfdTag "subjectLocation" 0xa214 showT +exposureIndex = exifSubIfdTag "exposureIndex" 0xa215 showT +sensingMethod = exifSubIfdTag "sensingMethod" 0xa217 ppSensingMethod +fileSource = exifSubIfdTag "fileSource" 0xa300 ppFileSource +sceneType = exifSubIfdTag "sceneType" 0xa301 ppSceneType +cfaPattern = exifSubIfdTag "cfaPattern" 0xa302 showT +customRendered = exifSubIfdTag "customRendered" 0xa401 ppCustomRendered +exposureMode = exifSubIfdTag "exposureMode" 0xa402 ppExposureMode +whiteBalance = exifSubIfdTag "whiteBalance" 0xa403 ppWhiteBalance +digitalZoomRatio = exifSubIfdTag "digitalZoomRatio" 0xa404 showT +focalLengthIn35mmFilm = exifSubIfdTag "focalLengthIn35mmFilm" 0xa405 $ asFpWithFormat "%s mm" +sceneCaptureType = exifSubIfdTag "sceneCaptureType" 0xa406 ppSceneCaptureType +gainControl = exifSubIfdTag "gainControl" 0xa407 ppGainControl +contrast = exifSubIfdTag "contrast" 0xa408 ppContrastSharpness +saturation = exifSubIfdTag "saturation" 0xa409 ppSaturation +sharpness = exifSubIfdTag "sharpness" 0xa40a ppContrastSharpness deviceSettingDescription= exifSubIfdTag "deviceSettingDescription" 0xa40b showT -subjectDistanceRange = exifSubIfdTag "subjectDistanceRange" 0xa40c ppSubjectDistanceRange -imageUniqueId = exifSubIfdTag "imageUniqueId" 0xa420 showT +subjectDistanceRange = exifSubIfdTag "subjectDistanceRange" 0xa40c ppSubjectDistanceRange +imageUniqueId = exifSubIfdTag "imageUniqueId" 0xa420 showT exifInteroperabilityOffset=exifSubIfdTag "exifInteroperabilityOffset" 0xa005 showT -imageDescription = exifIfd0Tag "imageDescription" 0x010e showT -make = exifIfd0Tag "make" 0x010f showT -model = exifIfd0Tag "model" 0x0110 showT -orientation = exifIfd0Tag "orientation" 0x0112 ppOrientation -xResolution = exifIfd0Tag "xResolution" 0x011a showT -yResolution = exifIfd0Tag "xResolution" 0x011b showT -resolutionUnit = exifIfd0Tag "resolutionUnit" 0x0128 ppResolutionUnit -software = exifIfd0Tag "software" 0x0131 showT -dateTime = exifIfd0Tag "dateTime" 0x0132 showT -artist = exifIfd0Tag "artist" 0x013b showT -whitePoint = exifIfd0Tag "whitePoint" 0x013e showT -primaryChromaticities = exifIfd0Tag "primaryChromaticities" 0x013f showT -yCbCrCoefficients = exifIfd0Tag "yCbCrCoefficients" 0x0211 showT -yCbCrPositioning = exifIfd0Tag "yCbCrPositioning" 0x0213 ppYCbCrPositioning -referenceBlackWhite = exifIfd0Tag "referenceBlackWhite" 0x0214 showT -copyright = exifIfd0Tag "copyright" 0x8298 showT -exifIfdOffset = exifIfd0Tag "exifIfdOffset" 0x8769 showT -gpsTagOffset = exifIfd0Tag "gpsTagOffset" 0x8825 showT -printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 ppUndef +imageDescription = exifIfd0Tag "imageDescription" 0x010e showT +make = exifIfd0Tag "make" 0x010f showT +model = exifIfd0Tag "model" 0x0110 showT +orientation = exifIfd0Tag "orientation" 0x0112 ppOrientation +xResolution = exifIfd0Tag "xResolution" 0x011a showT +yResolution = exifIfd0Tag "xResolution" 0x011b showT +resolutionUnit = exifIfd0Tag "resolutionUnit" 0x0128 ppResolutionUnit +software = exifIfd0Tag "software" 0x0131 showT +dateTime = exifIfd0Tag "dateTime" 0x0132 showT +artist = exifIfd0Tag "artist" 0x013b showT +whitePoint = exifIfd0Tag "whitePoint" 0x013e showT +primaryChromaticities = exifIfd0Tag "primaryChromaticities" 0x013f showT +yCbCrCoefficients = exifIfd0Tag "yCbCrCoefficients" 0x0211 showT +yCbCrPositioning = exifIfd0Tag "yCbCrPositioning" 0x0213 ppYCbCrPositioning +referenceBlackWhite = exifIfd0Tag "referenceBlackWhite" 0x0214 showT +copyright = exifIfd0Tag "copyright" 0x8298 showT +exifIfdOffset = exifIfd0Tag "exifIfdOffset" 0x8769 showT +gpsTagOffset = exifIfd0Tag "gpsTagOffset" 0x8825 showT +printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 ppUndef -gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 showT -gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 ppGpsLatitudeRef -gpsLatitude = exifGpsTag "gpsLatitude" 0x0002 ppGpsLongLat -gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 ppGpsLongitudeRef -gpsLongitude = exifGpsTag "gpsLongitude" 0x0004 ppGpsLongLat -gpsAltitudeRef = exifGpsTag "gpsAltitudeRef" 0x0005 ppGpsAltitudeRef -gpsAltitude = exifGpsTag "gpsAltitude" 0x0006 (T.pack . formatAsFloatingPoint 4) -gpsTimeStamp = exifGpsTag "gpsTimeStamp" 0x0007 ppGpsTimeStamp -gpsSatellites = exifGpsTag "gpsSatellites" 0x0008 showT -gpsStatus = exifGpsTag "gpsStatus" 0x0009 showT -gpsMeasureMode = exifGpsTag "gpsMeasureMode" 0x000a showT -gpsDop = exifGpsTag "gpsDop" 0x000b showT -gpsSpeedRef = exifGpsTag "gpsSpeedRef" 0x000c showT -gpsSpeed = exifGpsTag "gpsSpeed" 0x000d showT -gpsTrackRef = exifGpsTag "gpsTrackRef" 0x000e showT -gpsTrack = exifGpsTag "gpsTrack" 0x000f showT -gpsImgDirectionRef = exifGpsTag "gpsImgDirectionRef" 0x0010 showT -gpsImgDirection = exifGpsTag "gpsImgDirection" 0x0011 showT -gpsMapDatum = exifGpsTag "gpsMapDatum" 0x0012 showT -gpsDestLatitudeRef = exifGpsTag "gpsDestLatitudeRef" 0x0013 showT -gpsDestLatitude = exifGpsTag "gpsDestLatitude" 0x0014 showT -gpsDestLongitudeRef = exifGpsTag "gpsDestLongitudeRef" 0x0015 showT -gpsDestLongitude = exifGpsTag "gpsDestLongitude" 0x0016 showT -gpsDestBearingRef = exifGpsTag "gpsDestBearingRef" 0x0017 showT -gpsDestBearing = exifGpsTag "gpsDestBearing" 0x0018 showT -gpsDestDistanceRef = exifGpsTag "gpsDestDistanceRef" 0x0019 showT -gpsDestDistance = exifGpsTag "gpsDestDistance" 0x001a showT -gpsProcessingMethod = exifGpsTag "gpsProcessingMethod" 0x001b showT -gpsAreaInformation = exifGpsTag "gpsAreaInformation" 0x001c showT -gpsDateStamp = exifGpsTag "gpsDateStamp" 0x001d ppGpsDateStamp -gpsDifferential = exifGpsTag "gpsDifferential" 0x001e showT +gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 showT +gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 ppGpsLatitudeRef +gpsLatitude = exifGpsTag "gpsLatitude" 0x0002 ppGpsLongLat +gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 ppGpsLongitudeRef +gpsLongitude = exifGpsTag "gpsLongitude" 0x0004 ppGpsLongLat +gpsAltitudeRef = exifGpsTag "gpsAltitudeRef" 0x0005 ppGpsAltitudeRef +gpsAltitude = exifGpsTag "gpsAltitude" 0x0006 (T.pack . formatAsFloatingPoint 4) +gpsTimeStamp = exifGpsTag "gpsTimeStamp" 0x0007 ppGpsTimeStamp +gpsSatellites = exifGpsTag "gpsSatellites" 0x0008 showT +gpsStatus = exifGpsTag "gpsStatus" 0x0009 showT +gpsMeasureMode = exifGpsTag "gpsMeasureMode" 0x000a showT +gpsDop = exifGpsTag "gpsDop" 0x000b showT +gpsSpeedRef = exifGpsTag "gpsSpeedRef" 0x000c showT +gpsSpeed = exifGpsTag "gpsSpeed" 0x000d showT +gpsTrackRef = exifGpsTag "gpsTrackRef" 0x000e showT +gpsTrack = exifGpsTag "gpsTrack" 0x000f showT +gpsImgDirectionRef = exifGpsTag "gpsImgDirectionRef" 0x0010 showT +gpsImgDirection = exifGpsTag "gpsImgDirection" 0x0011 showT +gpsMapDatum = exifGpsTag "gpsMapDatum" 0x0012 showT +gpsDestLatitudeRef = exifGpsTag "gpsDestLatitudeRef" 0x0013 showT +gpsDestLatitude = exifGpsTag "gpsDestLatitude" 0x0014 showT +gpsDestLongitudeRef = exifGpsTag "gpsDestLongitudeRef" 0x0015 showT +gpsDestLongitude = exifGpsTag "gpsDestLongitude" 0x0016 showT +gpsDestBearingRef = exifGpsTag "gpsDestBearingRef" 0x0017 showT +gpsDestBearing = exifGpsTag "gpsDestBearing" 0x0018 showT +gpsDestDistanceRef = exifGpsTag "gpsDestDistanceRef" 0x0019 showT +gpsDestDistance = exifGpsTag "gpsDestDistance" 0x001a showT +gpsProcessingMethod = exifGpsTag "gpsProcessingMethod" 0x001b showT +gpsAreaInformation = exifGpsTag "gpsAreaInformation" 0x001c showT +gpsDateStamp = exifGpsTag "gpsDateStamp" 0x001d ppGpsDateStamp +gpsDifferential = exifGpsTag "gpsDifferential" 0x001e showT allExifTags :: [ExifTag] allExifTags = [exposureTime, fnumber, exposureProgram, isoSpeedRatings, - exifVersion, dateTimeOriginal, dateTimeDigitized, componentConfiguration, - compressedBitsPerPixel, shutterSpeedValue, apertureValue, brightnessValue, - exposureBiasValue, maxApertureValue, subjectDistance, meteringMode, - lightSource, flash, focalLength, makerNote, userComment, - exifImageWidth, exifImageHeight, relatedSoundFile, focalPlaneXResolution, - focalPlaneYResolution, focalPlaneResolutionUnit, sensingMethod, fileSource, - 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] + exifVersion, dateTimeOriginal, dateTimeDigitized, componentConfiguration, + compressedBitsPerPixel, shutterSpeedValue, apertureValue, brightnessValue, + exposureBiasValue, maxApertureValue, subjectDistance, meteringMode, + lightSource, flash, focalLength, makerNote, userComment, + exifImageWidth, exifImageHeight, relatedSoundFile, focalPlaneXResolution, + focalPlaneYResolution, focalPlaneResolutionUnit, sensingMethod, fileSource, + 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] -- | Extract the GPS latitude and longitude where the picture was taken -- (if it is present in the EXIF) getGpsLatitudeLongitude :: Map ExifTag ExifValue -> Maybe (Double, Double) getGpsLatitudeLongitude exifData = do - (ExifText latRef) <- Map.lookup gpsLatitudeRef exifData - latDec <- Map.lookup gpsLatitude exifData >>= gpsDecodeToDecimalDegrees - let signedLatDec = case latRef of - "S" -> -latDec - _ -> latDec - (ExifText longRef) <- Map.lookup gpsLongitudeRef exifData - longDec <- Map.lookup gpsLongitude exifData >>= gpsDecodeToDecimalDegrees - let signedLongDec = case longRef of - "W" -> -longDec - _ -> longDec - return (signedLatDec, signedLongDec) + (ExifText latRef) <- Map.lookup gpsLatitudeRef exifData + latDec <- Map.lookup gpsLatitude exifData >>= gpsDecodeToDecimalDegrees + let signedLatDec = if latRef == "S" then -latDec else latDec + (ExifText longRef) <- Map.lookup gpsLongitudeRef exifData + longDec <- Map.lookup gpsLongitude exifData >>= gpsDecodeToDecimalDegrees + let signedLongDec = if longRef == "W" then -longDec else longDec + return (signedLatDec, signedLongDec) gpsLongLatToCoords :: ExifValue -> Maybe (Double, Double, Double) gpsLongLatToCoords (ExifRationalList intPairs) = case fmap intPairToFloating intPairs of - (degrees:minutes:seconds:[]) -> Just (degrees, minutes, seconds) - _ -> Nothing - where - intPairToFloating (n, d) = fromIntegral n / fromIntegral d + [degrees, minutes, seconds] -> Just (degrees, minutes, seconds) + _ -> Nothing + where + intPairToFloating (n, d) = fromIntegral n / fromIntegral d gpsLongLatToCoords _ = Nothing gpsDecodeToDecimalDegrees :: ExifValue -> Maybe Double gpsDecodeToDecimalDegrees v = do - (degrees, minutes, seconds) <- gpsLongLatToCoords v - return $ degrees + minutes / 60 + seconds / 3600 + (degrees, minutes, seconds) <- gpsLongLatToCoords v + return $ degrees + minutes / 60 + seconds / 3600 ppGpsLongLat :: ExifValue -> Text ppGpsLongLat x = fromMaybe "Invalid GPS data" $ _ppGpsLongLat x _ppGpsLongLat :: ExifValue -> Maybe Text _ppGpsLongLat v = do - (degrees, minutes, seconds) <- gpsLongLatToCoords v - return $ T.pack $ printf "%.0f° %.0f' %.2f\"" degrees minutes seconds + (degrees, minutes, seconds) <- gpsLongLatToCoords v + return $ T.pack $ printf "%.0f° %.0f' %.2f\"" degrees minutes seconds -- | Extract the GPS date time, if present in the picture. getGpsDateTime :: Map ExifTag ExifValue -> Maybe LocalTime getGpsDateTime exifData = do - gpsDate <- Map.lookup gpsDateStamp exifData >>= parseGpsDate - gpsTime <- Map.lookup gpsTimeStamp exifData >>= parseGpsTime - return $ LocalTime gpsDate gpsTime + gpsDate <- Map.lookup gpsDateStamp exifData >>= parseGpsDate + gpsTime <- Map.lookup gpsTimeStamp exifData >>= parseGpsTime + return $ LocalTime gpsDate gpsTime parseGpsDate :: ExifValue -> Maybe Day parseGpsDate (ExifText dateStr) = runMaybeGet getExifDate $ stringToByteString dateStr @@ -222,24 +218,24 @@ getExifDate :: Get Day getExifDate = do - year <- readDigit 4 - month <- getCharValue ':' >> readDigit 2 - day <- getCharValue ':' >> readDigit 2 - return $ fromGregorian year month day + year <- readDigit 4 + month <- getCharValue ':' >> readDigit 2 + day <- getCharValue ':' >> readDigit 2 + return $ fromGregorian year month day -- | read the GPS time from the 'gpsTimeStamp' field. parseGpsTime :: ExifValue -> Maybe TimeOfDay parseGpsTime (ExifRationalList [(hr_n, hr_d), (min_n, min_d), (sec_n, sec_d)]) = - Just $ TimeOfDay (hr_n `div` hr_d) (min_n `div` min_d) (fromIntegral sec_n / fromIntegral sec_d) + Just $ TimeOfDay (hr_n `div` hr_d) (min_n `div` min_d) (fromIntegral sec_n / fromIntegral sec_d) parseGpsTime _ = Nothing ppGpsTimeStamp :: ExifValue -> Text ppGpsTimeStamp exifV = maybe "invalid" (T.pack . formatTod) $ parseGpsTime exifV - where formatTod (TimeOfDay h m s) = printf "%02d" h ++ ":" ++ printf "%02d" m ++ ":" ++ printf "%02.2f" (realToFrac s :: Float) + where formatTod (TimeOfDay h m s) = printf "%02d:%02d:%02.2f" h m (realToFrac s :: Float) ppGpsDateStamp :: ExifValue -> Text ppGpsDateStamp exifV = maybe "invalid" (T.pack . formatDay . toGregorian) $ parseGpsDate exifV - where formatDay (year, month, day) = show year ++ "-" ++ printf "%02d" month ++ "-" ++ printf "%02d" day + where formatDay (year, month, day) = printf "%d-%02d-%02d" year month day ppGpsLatitudeRef :: ExifValue -> Text ppGpsLatitudeRef (ExifText "N") = "North" diff --git a/Graphics/Helpers.hs b/Graphics/Helpers.hs --- a/Graphics/Helpers.hs +++ b/Graphics/Helpers.hs @@ -13,18 +13,18 @@ runEitherGet :: Get a -> B.ByteString -> Either String a runEitherGet get bs = case runGetOrFail get bs of - Left (_,_,errorMsg) -> Left errorMsg - Right (_,_,x) -> Right x + Left (_,_,errorMsg) -> Left errorMsg + Right (_,_,x) -> Right x runMaybeGet :: Get a -> B.ByteString -> Maybe a runMaybeGet get = hush . runEitherGet get getCharWhere :: (Char->Bool) -> Get Char getCharWhere wher = do - char <- chr . fromIntegral <$> getWord8 - if wher char - then return char - else fail "no parse" + char <- chr . fromIntegral <$> getWord8 + if wher char + then return char + else fail "no parse" getDigit :: Get Char getDigit = getCharWhere isDigit diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -2,151 +2,151 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -- | Ability to work with the EXIF data contained in JPEG files. module Graphics.HsExif ( - -- $intro + -- $intro - -- * Main functions - parseFileExif, - parseExif, + -- * Main functions + parseFileExif, + parseExif, - -- * Higher-level helper functions - readExifDateTime, - getDateTimeOriginal, - getOrientation, - ImageOrientation(..), - RotationDirection(..), - getGpsLatitudeLongitude, - wasFlashFired, - formatAsFloatingPoint, - getGpsDateTime, - parseGpsTime, + -- * Higher-level helper functions + readExifDateTime, + getDateTimeOriginal, + getOrientation, + ImageOrientation(..), + RotationDirection(..), + getGpsLatitudeLongitude, + wasFlashFired, + formatAsFloatingPoint, + getGpsDateTime, + parseGpsTime, - -- * The ExifValue type - ExifValue(..), + -- * The ExifValue type + ExifValue(..), - -- * Most useful exif tags - exposureTime, - fnumber, - isoSpeedRatings, - dateTimeOriginal, - shutterSpeedValue, - apertureValue, - brightnessValue, - exposureBiasValue, - maxApertureValue, - flash, - focalLength, - userComment, - orientation, - make, - model, - software, - copyright, - digitalZoomRatio, - focalLengthIn35mmFilm, - artist, + -- * Most useful exif tags + exposureTime, + fnumber, + isoSpeedRatings, + dateTimeOriginal, + shutterSpeedValue, + apertureValue, + brightnessValue, + exposureBiasValue, + maxApertureValue, + flash, + focalLength, + userComment, + orientation, + make, + model, + software, + copyright, + digitalZoomRatio, + focalLengthIn35mmFilm, + artist, - -- * GPS related exif tags + -- * 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, + 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 + -- * Less useful exif tags - exifVersion, - sensingMethod, - fileSource, - sceneType, - makerNote, - subjectDistance, - meteringMode, - lightSource, - exifImageWidth, - exifImageHeight, - relatedSoundFile, - focalPlaneXResolution, - focalPlaneYResolution, - focalPlaneResolutionUnit, - 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, + exifVersion, + sensingMethod, + fileSource, + sceneType, + makerNote, + subjectDistance, + meteringMode, + lightSource, + exifImageWidth, + exifImageHeight, + relatedSoundFile, + focalPlaneXResolution, + focalPlaneYResolution, + focalPlaneResolutionUnit, + 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(..), - TagLocation(..), + -- * If you need to declare your own exif tags + ExifTag(..), + TagLocation(..), ) where import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString.Lazy as B -import Control.Monad (liftM, unless) +import Control.Monad (liftM, unless, replicateM) import Control.Applicative ( (<$>) ) import qualified Data.ByteString.Char8 as Char8 import Data.Word @@ -179,21 +179,21 @@ getExif :: Get (Map ExifTag ExifValue) getExif = do - header <- getWord16be - unless (header == 0xffd8) - $ fail "Not a JPEG file" - findAndParseExifBlock + header <- getWord16be + unless (header == 0xffd8) + $ fail "Not a JPEG file" + findAndParseExifBlock findAndParseExifBlock :: Get (Map ExifTag ExifValue) findAndParseExifBlock = do - markerNumber <- getWord16be - dataSize <- fromIntegral . toInteger <$> getWord16be - case markerNumber of - 0xffe1 -> parseExifBlock - -- ffda is Start Of Stream => image - -- I expect no more EXIF data after this point. - 0xffda -> fail "No EXIF in JPEG" - _ -> skip (dataSize-2) >> findAndParseExifBlock + markerNumber <- getWord16be + dataSize <- fromIntegral . toInteger <$> getWord16be + case markerNumber of + 0xffe1 -> parseExifBlock + -- ffda is Start Of Stream => image + -- I expect no more EXIF data after this point. + 0xffda -> fail "No EXIF in JPEG" + _ -> skip (dataSize-2) >> findAndParseExifBlock data ByteAlign = Intel | Motorola @@ -211,240 +211,241 @@ parseExifBlock :: Get (Map ExifTag ExifValue) parseExifBlock = do - header <- getByteString 4 - nul <- toInteger <$> getWord16be - unless (header == Char8.pack "Exif" && nul == 0) - $ fail "invalid EXIF header" - tiffHeaderStart <- fromIntegral <$> bytesRead - byteAlign <- parseTiffHeader - let subIfdParse = parseSubIFD byteAlign tiffHeaderStart - (mExifSubIfdOffsetW, mGpsOffsetW, ifdEntries) <- parseIfd byteAlign tiffHeaderStart - gpsData <- maybe (return []) (lookAhead . subIfdParse GpsSubIFD) mGpsOffsetW - exifSubEntries <- maybe (return []) (subIfdParse ExifSubIFD) mExifSubIfdOffsetW - return $ Map.fromList $ ifdEntries ++ exifSubEntries ++ gpsData + header <- getByteString 4 + nul <- toInteger <$> getWord16be + unless (header == Char8.pack "Exif" && nul == 0) + $ fail "invalid EXIF header" + tiffHeaderStart <- fromIntegral <$> bytesRead + byteAlign <- parseTiffHeader + let subIfdParse = parseSubIFD byteAlign tiffHeaderStart + (mExifSubIfdOffsetW, mGpsOffsetW, ifdEntries) <- parseIfd byteAlign tiffHeaderStart + gpsData <- maybe (return []) (lookAhead . subIfdParse GpsSubIFD) mGpsOffsetW + exifSubEntries <- maybe (return []) (subIfdParse ExifSubIFD) mExifSubIfdOffsetW + return $ Map.fromList $ ifdEntries ++ exifSubEntries ++ gpsData parseSubIFD :: ByteAlign -> Int -> TagLocation -> Word32 -> Get [(ExifTag, ExifValue)] parseSubIFD byteAlign tiffHeaderStart ifdType offsetW = do - let offset = fromIntegral $ toInteger offsetW - bytesReadNow <- fromIntegral <$> bytesRead - skip $ (offset + tiffHeaderStart) - bytesReadNow - parseSubIfd byteAlign tiffHeaderStart ifdType + let offset = fromIntegral $ toInteger offsetW + bytesReadNow <- fromIntegral <$> bytesRead + skip $ (offset + tiffHeaderStart) - bytesReadNow + parseSubIfd byteAlign tiffHeaderStart ifdType parseTiffHeader :: Get ByteAlign parseTiffHeader = do - byteAlignV <- Char8.unpack <$> getByteString 2 - byteAlign <- case byteAlignV of - "II" -> return Intel - "MM" -> return Motorola - _ -> fail $ "Unknown byte alignment: " ++ byteAlignV - alignControl <- toInteger <$> getWord16 byteAlign - unless (alignControl == 0x2a) - $ fail "exif byte alignment mismatch" - ifdOffset <- fromIntegral . toInteger <$> getWord32 byteAlign - skip $ ifdOffset - 8 - return byteAlign + byteAlignV <- Char8.unpack <$> getByteString 2 + byteAlign <- case byteAlignV of + "II" -> return Intel + "MM" -> return Motorola + _ -> fail $ "Unknown byte alignment: " ++ byteAlignV + alignControl <- toInteger <$> getWord16 byteAlign + unless (alignControl == 0x2a) + $ fail "exif byte alignment mismatch" + ifdOffset <- fromIntegral . toInteger <$> getWord32 byteAlign + skip $ ifdOffset - 8 + return byteAlign parseIfd :: ByteAlign -> Int -> Get (Maybe Word32, Maybe Word32, [(ExifTag, ExifValue)]) parseIfd byteAlign tiffHeaderStart = do - dirEntriesCount <- toInteger <$> getWord16 byteAlign - ifdEntries <- mapM (\_ -> parseIfEntry byteAlign) [1..dirEntriesCount] - let exifOffset = entryContentsByTag exifIfdOffset ifdEntries - let gpsOffset = entryContentsByTag gpsTagOffset ifdEntries - entries <- mapM (decodeEntry byteAlign tiffHeaderStart IFD0) ifdEntries - return (exifOffset, gpsOffset, entries) + dirEntriesCount <- fromIntegral <$> getWord16 byteAlign + ifdEntries <- replicateM dirEntriesCount (parseIfEntry byteAlign) + let exifOffset = entryContentsByTag exifIfdOffset ifdEntries + let gpsOffset = entryContentsByTag gpsTagOffset ifdEntries + entries <- mapM (decodeEntry byteAlign tiffHeaderStart IFD0) ifdEntries + return (exifOffset, gpsOffset, entries) entryContentsByTag :: ExifTag -> [IfEntry] -> Maybe Word32 entryContentsByTag tag = fmap entryContents . find (\e -> entryTag e == tagKey tag) parseSubIfd :: ByteAlign -> Int -> TagLocation -> Get [(ExifTag, ExifValue)] parseSubIfd byteAlign tiffHeaderStart location = do - dirEntriesCount <- toInteger <$> getWord16 byteAlign - ifdEntries <- mapM (\_ -> parseIfEntry byteAlign) [1..dirEntriesCount] - mapM (decodeEntry byteAlign tiffHeaderStart location) ifdEntries + dirEntriesCount <- fromIntegral <$> getWord16 byteAlign + ifdEntries <- replicateM dirEntriesCount (parseIfEntry byteAlign) + mapM (decodeEntry byteAlign tiffHeaderStart location) ifdEntries data IfEntry = IfEntry - { - entryTag :: !Word16, - entryFormat :: !Word16, - entryNoComponents :: !Int, - entryContents :: !Word32 - } deriving Show + { + entryTag :: !Word16, + entryFormat :: !Word16, + entryNoComponents :: !Int, + entryContents :: !Word32 + } deriving Show parseIfEntry :: ByteAlign -> Get IfEntry parseIfEntry byteAlign = do - tagNumber <- getWord16 byteAlign - dataFormat <- getWord16 byteAlign - numComponents <- getWord32 byteAlign - value <- getWord32 byteAlign - return IfEntry - { - entryTag = tagNumber, - entryFormat = dataFormat, - entryNoComponents = fromIntegral $ toInteger numComponents, - entryContents = value - } + tagNumber <- getWord16 byteAlign + dataFormat <- getWord16 byteAlign + numComponents <- getWord32 byteAlign + value <- getWord32 byteAlign + return IfEntry + { + entryTag = tagNumber, + entryFormat = dataFormat, + entryNoComponents = fromIntegral $ toInteger numComponents, + entryContents = value + } getExifTag :: TagLocation -> Word16 -> ExifTag getExifTag l v = fromMaybe (ExifTag l Nothing v showT) $ find (isSameTag l v) allExifTags - where isSameTag l1 v1 (ExifTag l2 _ v2 _) = l1 == l2 && v1 == v2 + 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 - } + { + dataTypeId :: Word16, + dataLength :: Int, + readSingle :: ByteAlign -> Get ExifValue, + readMany :: ByteAlign -> Int -> Get ExifValue + } readNumberList :: Integral a => (ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue readNumberList decoder byteAlign components = ExifNumberList . fmap fromIntegral <$> - count components (decoder byteAlign) + count components (decoder byteAlign) unsignedByteValueHandler = ValueHandler - { - dataTypeId = 1, - dataLength = 1, - readSingle = \_ -> ExifNumber . fromIntegral <$> getWord8, - readMany = readNumberList $ const getWord8 - } + { + dataTypeId = 1, + dataLength = 1, + readSingle = \_ -> ExifNumber . fromIntegral <$> getWord8, + readMany = readNumberList $ const getWord8 + } asciiStringValueHandler = ValueHandler - { - dataTypeId = 2, - dataLength = 1, - readSingle = \ba -> readMany asciiStringValueHandler ba 1, - readMany = \_ components -> ExifText . Char8.unpack <$> getByteString (components-1) - } + { + dataTypeId = 2, + dataLength = 1, + readSingle = \ba -> readMany asciiStringValueHandler ba 1, + readMany = \_ components -> ExifText . Char8.unpack <$> getByteString (components-1) + } unsignedShortValueHandler = ValueHandler - { - dataTypeId = 3, - dataLength = 2, - readSingle = liftM (ExifNumber . fromIntegral) . getWord16, - readMany = readNumberList getWord16 - } + { + dataTypeId = 3, + dataLength = 2, + readSingle = liftM (ExifNumber . fromIntegral) . getWord16, + readMany = readNumberList getWord16 + } unsignedLongValueHandler = ValueHandler - { - dataTypeId = 4, - dataLength = 4, - readSingle = liftM (ExifNumber . fromIntegral) . getWord32, - readMany = readNumberList getWord32 - } + { + dataTypeId = 4, + dataLength = 4, + readSingle = liftM (ExifNumber . fromIntegral) . getWord32, + readMany = readNumberList getWord32 + } readRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a readRationalContents c byteAlign = do - numerator <- fromIntegral <$> getWord32 byteAlign - denominator <- fromIntegral <$> getWord32 byteAlign - return $ c numerator denominator + numerator <- fromIntegral <$> getWord32 byteAlign + denominator <- fromIntegral <$> getWord32 byteAlign + return $ c numerator denominator unsignedRationalValueHandler = ValueHandler - { - dataTypeId = 5, - dataLength = 8, - readSingle = readRationalContents ExifRational, - readMany = \byteAlign components -> ExifRationalList <$> count components (readRationalContents (,) byteAlign) - } + { + dataTypeId = 5, + dataLength = 8, + readSingle = readRationalContents ExifRational, + readMany = \byteAlign components -> ExifRationalList <$> count components (readRationalContents (,) byteAlign) + } signedByteValueHandler = ValueHandler - { - dataTypeId = 6, - dataLength = 1, - readSingle = \_ -> ExifNumber . signedInt8ToInt <$> getWord8, - readMany = readNumberList (liftM signedInt8ToInt . const getWord8) - } + { + dataTypeId = 6, + dataLength = 1, + readSingle = \_ -> ExifNumber . signedInt8ToInt <$> getWord8, + readMany = readNumberList (liftM signedInt8ToInt . const getWord8) + } undefinedValueHandler = ValueHandler - { - dataTypeId = 7, - dataLength = 1, - readSingle = \ba -> readMany undefinedValueHandler ba 1, - readMany = \_ components -> ExifUndefined <$> getByteString components - } + { + dataTypeId = 7, + dataLength = 1, + readSingle = \ba -> readMany undefinedValueHandler ba 1, + readMany = \_ components -> ExifUndefined <$> getByteString components + } signedShortValueHandler = ValueHandler - { - dataTypeId = 8, - dataLength = 2, - readSingle = liftM (ExifNumber . signedInt16ToInt) . getWord16, - readMany = readNumberList (liftM signedInt16ToInt . getWord16) - } + { + dataTypeId = 8, + dataLength = 2, + readSingle = liftM (ExifNumber . signedInt16ToInt) . getWord16, + readMany = readNumberList (liftM signedInt16ToInt . getWord16) + } signedLongValueHandler = ValueHandler - { - dataTypeId = 9, - dataLength = 4, - readSingle = liftM (ExifNumber . signedInt32ToInt) . getWord32, - readMany = readNumberList (liftM signedInt32ToInt . getWord32) - } + { + dataTypeId = 9, + dataLength = 4, + readSingle = liftM (ExifNumber . signedInt32ToInt) . getWord32, + readMany = readNumberList (liftM signedInt32ToInt . getWord32) + } readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a readSignedRationalContents c byteAlign = do - numerator <- signedInt32ToInt <$> getWord32 byteAlign - denominator <- signedInt32ToInt <$> getWord32 byteAlign - return $ c numerator denominator + numerator <- signedInt32ToInt <$> getWord32 byteAlign + denominator <- signedInt32ToInt <$> getWord32 byteAlign + return $ c numerator denominator signedRationalValueHandler = ValueHandler - { - dataTypeId = 10, - dataLength = 8, - readSingle = readSignedRationalContents ExifRational, - readMany = \byteAlign components -> ExifRationalList <$> count components (readSignedRationalContents (,) byteAlign) - } + { + dataTypeId = 10, + dataLength = 8, + readSingle = readSignedRationalContents ExifRational, + readMany = \byteAlign components -> ExifRationalList <$> + count components (readSignedRationalContents (,) byteAlign) + } valueHandlers :: [ValueHandler] valueHandlers = - [ - unsignedByteValueHandler, - asciiStringValueHandler, - unsignedShortValueHandler, - unsignedLongValueHandler, - unsignedRationalValueHandler, - signedByteValueHandler, - signedShortValueHandler, - signedLongValueHandler, - signedRationalValueHandler, - undefinedValueHandler - ] + [ + 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 - -- 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 getHandler $ entryFormat entry of - Just handler -> decodeEntryWithHandler byteAlign tiffHeaderStart handler entry - Nothing -> return $ ExifUnknown (entryFormat entry) (entryNoComponents entry) contentsInt - return (exifTag, tagValue) + let exifTag = getExifTag location $ entryTag entry + let contentsInt = fromIntegral $ toInteger $ entryContents 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 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 = - if dataLength handler * entryNoComponents entry <= 4 - then do - let inlineBs = runPut $ putWord32 byteAlign $ entryContents entry - return $ parseInline byteAlign handler entry inlineBs - else parseOffset byteAlign tiffHeaderStart handler entry + if dataLength handler * entryNoComponents entry <= 4 + then do + let inlineBs = runPut $ putWord32 byteAlign $ entryContents entry + return $ parseInline byteAlign handler entry inlineBs + else parseOffset byteAlign tiffHeaderStart handler 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 + 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 <- fromIntegral <$> bytesRead - skip $ contentsInt + tiffHeaderStart - curPos - bytestring <- getLazyByteString (fromIntegral $ entryNoComponents entry * dataLength handler) - return $ parseInline byteAlign handler entry bytestring + let contentsInt = fromIntegral $ toInteger $ entryContents entry + curPos <- 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) @@ -462,58 +463,53 @@ getExifDateTime :: Get LocalTime getExifDateTime = do - year <- readDigit 4 - month <- getCharValue ':' >> readDigit 2 - day <- getCharValue ':' >> readDigit 2 - hour <- getCharValue ' ' >> readDigit 2 - minute <- getCharValue ':' >> readDigit 2 - second <- getCharValue ':' >> readDigit 2 - -- the realToFrac is workaround for a GHC 7.8.0->7.8.2 bug: - -- https://ghc.haskell.org/trac/ghc/ticket/9231 - -- actually generates a warning and it's good, reminds me to - -- remove it someday, since 7.8.3 is out and with the fix. - return $ LocalTime (fromGregorian year month day) (TimeOfDay hour minute $ realToFrac second) - + year <- readDigit 4 + month <- getCharValue ':' >> readDigit 2 + day <- getCharValue ':' >> readDigit 2 + hour <- getCharValue ' ' >> readDigit 2 + minute <- getCharValue ':' >> readDigit 2 + second <- getCharValue ':' >> readDigit 2 + return $ LocalTime (fromGregorian year month day) (TimeOfDay hour minute second) + -- | Extract the date and time when the picture was taken -- from the EXIF information. getDateTimeOriginal :: Map ExifTag ExifValue -> Maybe LocalTime -getDateTimeOriginal exifData = Map.lookup dateTimeOriginal exifData >>= readExifDateTime . show +getDateTimeOriginal exifData = Map.lookup dateTimeOriginal exifData >>= readExifDateTime . show data RotationDirection = MinusNinety - | Ninety - | HundredAndEighty - deriving (Show, Eq) + | Ninety + | HundredAndEighty + deriving (Show, Eq) data ImageOrientation = Normal - | Mirror - | Rotation RotationDirection - | MirrorRotation RotationDirection - deriving (Show, Eq) + | Mirror + | Rotation RotationDirection + | MirrorRotation RotationDirection + deriving (Show, Eq) -- | Extract the image orientation from the EXIF information. -- Will return 'Nothing' on parse error. getOrientation :: Map ExifTag ExifValue -> Maybe ImageOrientation getOrientation exifData = do - rotationVal <- Map.lookup orientation exifData - case rotationVal of - ExifNumber 1 -> Just Normal - ExifNumber 2 -> Just Mirror - ExifNumber 3 -> Just $ Rotation HundredAndEighty - ExifNumber 4 -> Just $ MirrorRotation HundredAndEighty - ExifNumber 5 -> Just $ MirrorRotation MinusNinety - ExifNumber 6 -> Just $ Rotation MinusNinety - ExifNumber 7 -> Just $ MirrorRotation Ninety - ExifNumber 8 -> Just $ Rotation Ninety - _ -> Nothing + rotationVal <- Map.lookup orientation exifData + case rotationVal of + ExifNumber 1 -> Just Normal + ExifNumber 2 -> Just Mirror + ExifNumber 3 -> Just $ Rotation HundredAndEighty + ExifNumber 4 -> Just $ MirrorRotation HundredAndEighty + ExifNumber 5 -> Just $ MirrorRotation MinusNinety + ExifNumber 6 -> Just $ Rotation MinusNinety + ExifNumber 7 -> Just $ MirrorRotation Ninety + ExifNumber 8 -> Just $ Rotation Ninety + _ -> Nothing -- | Will return Just True if the flash was fired, Just False -- if it was not, and Nothing if the file does not contain -- the information. wasFlashFired :: Map ExifTag ExifValue -> Maybe Bool -wasFlashFired exifData = do - Map.lookup flash exifData >>= \case - ExifNumber n -> Just $ n .&. 1 /= 0 - _ -> Nothing +wasFlashFired exifData = Map.lookup flash exifData >>= \case + ExifNumber n -> Just $ n .&. 1 /= 0 + _ -> Nothing -- $intro -- diff --git a/Graphics/PrettyPrinters.hs b/Graphics/PrettyPrinters.hs --- a/Graphics/PrettyPrinters.hs +++ b/Graphics/PrettyPrinters.hs @@ -1,12 +1,14 @@ {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} module Graphics.PrettyPrinters where -import Data.List (foldl') import Text.Printf (printf) +import Data.Map (Map) +import Data.Maybe import qualified Data.Map as Map import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Control.Arrow (first) +import Control.Applicative import Data.Text.Encoding (decodeUtf8) import qualified Data.Text as T import Data.Text (Text) @@ -21,8 +23,8 @@ ppResolutionUnit :: ExifValue -> Text ppResolutionUnit = fromNumberMap [(1, "No absolute unit"), - (2, "Inch"), - (3, "Centimeter")] + (2, "Inch"), + (3, "Centimeter")] ppYCbCrPositioning :: ExifValue -> Text ppYCbCrPositioning = fromNumberMap [(1, "Centered"), (2, "Co-sited")] @@ -32,71 +34,71 @@ ppExposureProgram :: ExifValue -> Text ppExposureProgram = fromNumberMap [(0, "Not defined"), - (1, "Manual"), - (2, "Normal program"), - (3, "Aperture priority"), - (4, "Shutter priority"), - (5, "Creative program (biased toward depth of field)"), - (6, "Action program (biased toward fast shutter speed)"), - (7, "Portrait mode (for closeup photos with the background out of focus)"), - (8, "Landscape mode (for landscape photos with the background in focus)")] + (1, "Manual"), + (2, "Normal program"), + (3, "Aperture priority"), + (4, "Shutter priority"), + (5, "Creative program (biased toward depth of field)"), + (6, "Action program (biased toward fast shutter speed)"), + (7, "Portrait mode (for closeup photos with the background out of focus)"), + (8, "Landscape mode (for landscape photos with the background in focus)")] ppMeteringMode :: ExifValue -> Text ppMeteringMode = fromNumberMap [(0, "Unknown"), - (1, "Average"), - (2, "Center-weighted average"), - (3, "Spot"), - (4, "MultiSpot"), - (5, "Pattern"), - (6, "Partial"), - (255, "other")] + (1, "Average"), + (2, "Center-weighted average"), + (3, "Spot"), + (4, "MultiSpot"), + (5, "Pattern"), + (6, "Partial"), + (255, "other")] ppLightSource :: ExifValue -> Text ppLightSource = fromNumberMap [(0, "Unknown"), - (1, "Daylight"), - (2, "Fluorescent"), - (3, "Tungsten (incandescent light)"), - (4, "Flash"), - (9, "Fine weather"), - (10, "Cloudy weather"), - (11, "Shade"), - (12, "Daylight fluorescent (D 5700 - 7100K)"), - (13, "Day white fluorescent (N 4600 - 5400K)"), - (14, "Cool white fluorescent (W 3900 - 4500K)"), - (15, "White fluorescent (WW 3200 - 3700K)"), - (17, "Standard light A"), - (18, "Standard light B"), - (19, "Standard light C"), - (20, "D55"), - (21, "D65"), - (22, "D75"), - (23, "D50"), - (24, "ISO studio tungsten"), - (255, "Other light source")] + (1, "Daylight"), + (2, "Fluorescent"), + (3, "Tungsten (incandescent light)"), + (4, "Flash"), + (9, "Fine weather"), + (10, "Cloudy weather"), + (11, "Shade"), + (12, "Daylight fluorescent (D 5700 - 7100K)"), + (13, "Day white fluorescent (N 4600 - 5400K)"), + (14, "Cool white fluorescent (W 3900 - 4500K)"), + (15, "White fluorescent (WW 3200 - 3700K)"), + (17, "Standard light A"), + (18, "Standard light B"), + (19, "Standard light C"), + (20, "D55"), + (21, "D65"), + (22, "D75"), + (23, "D50"), + (24, "ISO studio tungsten"), + (255, "Other light source")] ppFlash :: ExifValue -> Text ppFlash = fromNumberMap [(0, "Flash did not fire"), - (1, "Flash fired"), - (5, "Strobe return light not detected"), - (7, "Strobe return light detected"), - (9, "Flash fired, compulsory flash mode"), - (0x0D, "Flash fired, compulsory flash mode, return light not detected"), - (0x0F, "Flash fired, compulsory flash mode, return light detected"), - (0x10, "Flash did not fire, compulsory flash mode"), - (0x18, "Flash did not fire, auto mode"), - (0x19, "Flash fired, auto mode"), - (0x1D, "Flash fired, auto mode, return light not detected"), - (0x1F, "Flash fired, auto mode, return light detected"), - (0x20, "No flash function"), - (0x41, "Flash fired, red-eye reduction mode"), - (0x45, "Flash fired, red-eye reduction mode, return light not detected"), - (0x47, "Flash fired, red-eye reduction mode, return light detected"), - (0x49, "Flash fired, compulsory flash mode, red-eye reduction mode"), - (0x4D, "Flash fired, compulsory flash mode, red-eye reduction mode, return light not detected"), - (0x4F, "Flash fired, compulsory flash mode, red-eye reduction mode, return light detected"), - (0x59, "Flash fired, auto mode, red-eye reduction mode"), - (0x5D, "Flash fired, auto mode, return light not detected, red-eye reduction mode"), - (0x5F, "Flash fired, auto mode, return light detected, red-eye reduction mode")] + (1, "Flash fired"), + (5, "Strobe return light not detected"), + (7, "Strobe return light detected"), + (9, "Flash fired, compulsory flash mode"), + (0x0D, "Flash fired, compulsory flash mode, return light not detected"), + (0x0F, "Flash fired, compulsory flash mode, return light detected"), + (0x10, "Flash did not fire, compulsory flash mode"), + (0x18, "Flash did not fire, auto mode"), + (0x19, "Flash fired, auto mode"), + (0x1D, "Flash fired, auto mode, return light not detected"), + (0x1F, "Flash fired, auto mode, return light detected"), + (0x20, "No flash function"), + (0x41, "Flash fired, red-eye reduction mode"), + (0x45, "Flash fired, red-eye reduction mode, return light not detected"), + (0x47, "Flash fired, red-eye reduction mode, return light detected"), + (0x49, "Flash fired, compulsory flash mode, red-eye reduction mode"), + (0x4D, "Flash fired, compulsory flash mode, red-eye reduction mode, return light not detected"), + (0x4F, "Flash fired, compulsory flash mode, red-eye reduction mode, return light detected"), + (0x59, "Flash fired, auto mode, red-eye reduction mode"), + (0x5D, "Flash fired, auto mode, return light not detected, red-eye reduction mode"), + (0x5F, "Flash fired, auto mode, return light detected, red-eye reduction mode")] ppColorSpace :: ExifValue -> Text ppColorSpace = fromNumberMap [(1, "sRGB"), (65535, "Uncalibrated")] @@ -106,85 +108,79 @@ ppExposureMode :: ExifValue -> Text ppExposureMode = fromNumberMap [(0, "Auto exposure"), - (1, "Manual exposure"), - (2, "Auto bracket")] + (1, "Manual exposure"), + (2, "Auto bracket")] ppWhiteBalance :: ExifValue -> Text ppWhiteBalance = fromNumberMap [(0, "Auto white balance"), - (1, "Manual white balance")] + (1, "Manual white balance")] ppSceneCaptureType :: ExifValue -> Text ppSceneCaptureType = fromNumberMap [(0, "Standard"), - (1, "Landscape"), - (2, "Portrait"), - (3, "Night scene")] + (1, "Landscape"), + (2, "Portrait"), + (3, "Night scene")] ppGainControl :: ExifValue -> Text ppGainControl = fromNumberMap [(0, "Normal"), - (1, "Low gain up"), - (2, "High gain up"), - (3, "Low gain down"), - (4, "High gain down")] + (1, "Low gain up"), + (2, "High gain up"), + (3, "Low gain down"), + (4, "High gain down")] ppContrastSharpness :: ExifValue -> Text ppContrastSharpness = fromNumberMap [(0, "Normal"), (1, "Soft"), (2, "Hard")] ppSaturation :: ExifValue -> Text ppSaturation = fromNumberMap [(0, "Normal"), - (1, "Low saturation"), - (2, "High saturation")] + (1, "Low saturation"), + (2, "High saturation")] ppSensingMethod :: ExifValue -> Text ppSensingMethod = fromNumberMap [(1, "Not defined"), - (2, "One-chip color area sensor"), - (3, "Two-chip color area sensor"), - (4, "Three-chip color area sensor"), - (5, "Color sequential area sensor"), - (7, "Trilinear sensor"), - (8, "Color sequential linear sensor")] + (2, "One-chip color area sensor"), + (3, "Two-chip color area sensor"), + (4, "Three-chip color area sensor"), + (5, "Color sequential area sensor"), + (7, "Trilinear sensor"), + (8, "Color sequential linear sensor")] ppSubjectDistanceRange :: ExifValue -> Text ppSubjectDistanceRange = fromNumberMap [(0, "Unknown"), - (1, "Macro"), - (2, "Close view"), - (3, "Distance view")] + (1, "Macro"), + (2, "Close view"), + (3, "Distance view")] ppFocalPlaneResolutionUnit :: ExifValue -> Text ppFocalPlaneResolutionUnit = fromNumberMap [(1, "No absolute unit of measurement"), - (2, "Inch"), - (3, "Centimeter")] + (2, "Inch"), + (3, "Centimeter")] ppOrientation :: ExifValue -> Text ppOrientation = fromNumberMap [(1, "Top-left"), - (2, "Top-right"), - (3, "Bottom-right"), - (4, "Bottom-left"), - (5, "Left-top"), - (6, "Right-top"), - (7, "Right-bottom"), - (8, "Left-bottom")] + (2, "Top-right"), + (3, "Bottom-right"), + (4, "Bottom-left"), + (5, "Left-top"), + (6, "Right-top"), + (7, "Right-bottom"), + (8, "Left-bottom")] ppSceneType :: ExifValue -> Text ppSceneType = fromNumberMap [(1, "Directly photographed")] ppGpsAltitudeRef :: ExifValue -> Text ppGpsAltitudeRef = fromNumberMap [(0, "Sea level"), - (1, "Below sea level")] + (1, "Below sea level")] +componentMap :: Map Int Text +componentMap = Map.fromList $ zip [0..] ["-", "Y", "Cb", "Cr", "R", "G", "B"] + ppComponentConfiguration :: ExifValue -> Text -ppComponentConfiguration (ExifUndefined bs) = T.pack $ foldl' addComponent [] numbers - where - numbers :: [Int] = fmap fromIntegral $ BS.unpack bs - addComponent soFar c = soFar ++ formatComponent c - formatComponent c = case c of - 0 -> "-" - 1 -> "Y" - 2 -> "Cb" - 3 -> "Cr" - 4 -> "R" - 5 -> "G" - 6 -> "B" - _ -> "?" +ppComponentConfiguration (ExifUndefined bs) = T.concat $ map formatComponent numbers + where + numbers = fromIntegral <$> BS.unpack bs + formatComponent = fromMaybe "?" . flip Map.lookup componentMap ppComponentConfiguration v@_ = unknown v ppFlashPixVersion :: ExifValue -> Text @@ -195,16 +191,16 @@ formatVersion :: String -> ExifValue -> Text formatVersion fmt (ExifUndefined s) = T.pack $ printf fmt num - where - num :: Float = read asStr / 100.0 - asStr = T.unpack $ decodeUtf8 s + where + num :: Float = read asStr / 100.0 + asStr = T.unpack $ decodeUtf8 s formatVersion _ v@_ = unknown v ppUserComment :: ExifValue -> Text ppUserComment (ExifUndefined v) = decodeUtf8 $ BL.toStrict $ convertFuzzy Transliterate encoding "UTF8" rawText - where - encoding = getIconvEncodingName $ decodeUtf8 $ BS.take 8 v - rawText = BL.fromStrict $ BS.drop 8 v + where + encoding = getIconvEncodingName $ decodeUtf8 $ BS.take 8 v + rawText = BL.fromStrict $ BS.drop 8 v ppUserComment v@_ = unknown v -- | Pretty printer for the FileSource tag @@ -220,7 +216,7 @@ fromNumberMap :: [(Int, Text)] -> ExifValue -> Text fromNumberMap m = fromMap convertedMap - where convertedMap = fmap (first ExifNumber) m + where convertedMap = fmap (first ExifNumber) m fromMap :: [(ExifValue, Text)] -> ExifValue -> Text fromMap m v = Map.findWithDefault (unknown v) v $ Map.fromList m diff --git a/Graphics/Types.hs b/Graphics/Types.hs --- a/Graphics/Types.hs +++ b/Graphics/Types.hs @@ -9,45 +9,45 @@ import Data.Text (Text) -- | An exif value. --- +-- -- If you want a string describing the contents -- of the value, simply use 'show'. data ExifValue = ExifNumber !Int - -- ^ An exif number. Originally it could have been short, int, signed or not. - | ExifText !String - -- ^ ASCII text. - | ExifRational !Int !Int - -- ^ A rational number (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. - | 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, Ord) + -- ^ An exif number. Originally it could have been short, int, signed or not. + | ExifText !String + -- ^ ASCII text. + | ExifRational !Int !Int + -- ^ A rational number (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. + | 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, Ord) instance Show ExifValue where - show (ExifNumber v) = show v - show (ExifText v) = v - show (ExifRational n d) = show n ++ "/" ++ show d - 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 + show (ExifNumber v) = show v + show (ExifText v) = v + show (ExifRational n d) = show n ++ "/" ++ show d + 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 -- | Location of the tag in the JPG file structure. -- Normally you don't need to fiddle with this, @@ -56,7 +56,7 @@ -- Rather check the list of supported exif tags, like -- 'exposureTime' and so on. data TagLocation = ExifSubIFD | IFD0 | GpsSubIFD - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord) -- | An exif tag. Normally you don't need to fiddle with this, -- except maybe if the library doesn't know the particular @@ -64,34 +64,34 @@ -- Rather check the list of supported exif tags, like -- 'exposureTime' and so on. data ExifTag = ExifTag - { - tagLocation :: TagLocation, - -- ^ In which part of the JPEG file the exif tag was found - tagDesc :: Maybe String, - -- ^ Description of the exif tag (exposureTime, fnumber...) or if unknown, Nothing. - -- This should be purely for debugging purposes, to compare tags use == on ExifTag - -- or compare the tagKey. - tagKey :: Word16, - -- ^ Exif tag key, the number uniquely identifying this tag. - prettyPrinter :: ExifValue -> Text - -- ^ A function that'll display nicely an exif value for that exif tag. - -- For instance for the 'flash' ExifTag, it'll say whether the flash was - -- fired or not, if there was return light and so on. - } + { + tagLocation :: TagLocation, + -- ^ In which part of the JPEG file the exif tag was found + tagDesc :: Maybe String, + -- ^ Description of the exif tag (exposureTime, fnumber...) or if unknown, Nothing. + -- This should be purely for debugging purposes, to compare tags use == on ExifTag + -- or compare the tagKey. + tagKey :: Word16, + -- ^ Exif tag key, the number uniquely identifying this tag. + prettyPrinter :: ExifValue -> Text + -- ^ A function that'll display nicely an exif value for that exif tag. + -- For instance for the 'flash' ExifTag, it'll say whether the flash was + -- fired or not, if there was return light and so on. + } instance Show ExifTag where - show (ExifTag _ (Just d) _ _) = d - show (ExifTag l _ v _) = "Unknown tag, location: " ++ show l - ++ ", value: 0x" ++ showHex v "" + show (ExifTag _ (Just d) _ _) = d + show (ExifTag l _ v _) = "Unknown tag, location: " ++ show l + ++ ", value: 0x" ++ showHex v "" instance Eq ExifTag where - t1 == t2 = tagKey t1 == tagKey t2 && tagLocation t1 == tagLocation t2 + t1 == t2 = tagKey t1 == tagKey t2 && tagLocation t1 == tagLocation t2 instance Ord ExifTag where - compare t1 t2 = if locCmp /= EQ then locCmp else tagCmp - where - locCmp = (compare `on` tagLocation) t1 t2 - tagCmp = (compare `on` tagKey) t1 t2 + compare t1 t2 = if locCmp /= EQ then locCmp else tagCmp + where + locCmp = (compare `on` tagLocation) t1 t2 + tagCmp = (compare `on` tagKey) t1 t2 -- | Format the exif value as floating-point if it makes sense, -- otherwise use the default 'show' implementation. @@ -101,9 +101,9 @@ formatAsFloatingPoint :: Int -> ExifValue -> String formatAsFloatingPoint n (ExifRational num den) = formatNumDenAsString n num den formatAsFloatingPoint n (ExifRationalList values) = intercalate ", " $ foldl' step [] values - where step soFar (num,den) = soFar ++ [formatNumDenAsString n num den] + where step soFar (num,den) = soFar ++ [formatNumDenAsString n num den] formatAsFloatingPoint _ v = show v formatNumDenAsString :: Int -> Int -> Int -> String formatNumDenAsString n num den = printf formatString (fromIntegral num / fromIntegral den :: Double) - where formatString = "%." ++ show n ++ "f" + where formatString = "%." ++ show n ++ "f" diff --git a/hsexif.cabal b/hsexif.cabal --- a/hsexif.cabal +++ b/hsexif.cabal @@ -1,8 +1,8 @@ --- Initial hsexif.cabal generated by cabal init. For further +-- Initial hsexif.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ name: hsexif -version: 0.6.0.1 +version: 0.6.0.2 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. @@ -11,24 +11,24 @@ license-file: LICENSE author: Emmanuel Touzery maintainer: etouzery@gmail.com --- copyright: +-- copyright: category: Graphics build-type: Simple --- extra-source-files: +-- extra-source-files: cabal-version: >=1.10 library exposed-modules: Graphics.HsExif other-modules: Graphics.Types, Graphics.PrettyPrinters, Graphics.ExifTags, Graphics.Helpers - -- other-extensions: + -- other-extensions: build-depends: base >=4.6 && <5, binary >=0.7 && <0.8, bytestring >=0.10 && <0.11, containers >= 0.5 && <0.6, - time >= 1.4 && <1.5, + time >= 1.4 && <1.6, iconv >= 0.4 && <0.5, text >= 0.9 - -- hs-source-dirs: + -- hs-source-dirs: default-language: Haskell2010 Ghc-Options: -Wall @@ -38,12 +38,12 @@ main-is: Tests.hs default-language: Haskell2010 build-depends: base, - hspec >= 1.8 && < 1.11, + hspec, HUnit >= 1.2 && <1.3, binary >=0.7 && <0.8, bytestring >=0.10 && <0.11, containers >= 0.5 && <0.6, - time >= 1.4 && <1.5, + time >= 1.4 && <1.6, iconv >= 0.4 && <0.5, text >= 0.9 Ghc-Options: -Wall diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -10,210 +10,203 @@ import Data.Time.LocalTime import Data.Time.Calendar import Data.Char (chr) +import Control.Monad (join) import Control.Applicative ( (<$>) ) import Data.List import Graphics.HsExif +import Graphics.Helpers main :: IO () main = do - imageContents <- B.readFile "tests/test.jpg" - noExif <- B.readFile "tests/noexif.jpg" - png <- B.readFile "tests/test.png" - gps <- B.readFile "tests/gps.jpg" - gps2 <- B.readFile "tests/gps2.jpg" - partial <- B.readFile "tests/partial_exif.jpg" - let parseExifCorrect = (\(Right x) -> x) . parseExif - let exifData = parseExifCorrect imageContents - let gpsExifData = parseExifCorrect gps - let gps2ExifData = parseExifCorrect gps2 - hspec $ do - describe "not a JPG" $ testNotAJpeg png - describe "no EXIF" $ testNoExif noExif - describe "basic parsing" $ testBasic imageContents - describe "extract picture date" $ testDate exifData - describe "image orientation" $ testOrientation exifData - describe "read exif date time" testReadExifDateTime - describe "read GPS lat long" $ testReadGpsLatLong gpsExifData - describe "read GPS lat long -- no data" $ testReadGpsLatLongNoData exifData - describe "test formatAsFloatingPoint" testFormatAsFloatingPoint - describe "pretty printing" $ testPrettyPrint gpsExifData exifData gps2ExifData - describe "flash fired" $ testFlashFired exifData - describe "partial exif data" $ testPartialExif partial + imageContents <- B.readFile "tests/test.jpg" + noExif <- B.readFile "tests/noexif.jpg" + png <- B.readFile "tests/test.png" + gps <- B.readFile "tests/gps.jpg" + gps2 <- B.readFile "tests/gps2.jpg" + partial <- B.readFile "tests/partial_exif.jpg" + let parseExifM = hush . parseExif + let exifData = parseExifM imageContents + let gpsExifData = parseExifM gps + let gps2ExifData = parseExifM gps2 + hspec $ do + describe "not a JPG" $ testNotAJpeg png + describe "no EXIF" $ testNoExif noExif + describe "basic parsing" $ testBasic imageContents + describe "extract picture date" $ testDate exifData + describe "image orientation" $ testOrientation exifData + describe "read exif date time" testReadExifDateTime + describe "read GPS lat long" $ testReadGpsLatLong gpsExifData + describe "read GPS lat long -- no data" $ testReadGpsLatLongNoData exifData + describe "test formatAsFloatingPoint" testFormatAsFloatingPoint + describe "pretty printing" $ testPrettyPrint gpsExifData exifData gps2ExifData + describe "flash fired" $ testFlashFired exifData + describe "partial exif data" $ testPartialExif partial testNotAJpeg :: B.ByteString -> Spec testNotAJpeg imageContents = it "returns empty list if not a JPEG" $ - assertEqual' (Left "Not a JPEG file") (parseExif imageContents) + assertEqual' (Left "Not a JPEG file") (parseExif imageContents) testNoExif :: B.ByteString -> Spec testNoExif imageContents = it "returns empty list if no EXIF" $ - assertEqual' (Left "No EXIF in JPEG") (parseExif imageContents) + assertEqual' (Left "No EXIF in JPEG") (parseExif imageContents) testBasic :: B.ByteString -> Spec testBasic imageContents = it "parses a simple JPEG" $ do - assertEqualListDebug - (sort [ - (exposureTime, ExifRational 1 160), - (fnumber, ExifRational 0 10), - (exposureProgram, ExifNumber 2), - (isoSpeedRatings, ExifNumber 1600), - (exifVersion, ExifUndefined "0230"), - (dateTimeOriginal, ExifText "2013:10:02 20:33:33"), - (dateTimeDigitized, ExifText "2013:10:02 20:33:33"), - (componentConfiguration, ExifUndefined "\SOH\STX\ETX\NUL"), - (compressedBitsPerPixel, ExifRational 2 1), - (brightnessValue, ExifRational (-4226) 2560), - (exposureBiasValue, ExifRational 0 10), - (maxApertureValue, ExifRational 0 10), - (meteringMode, ExifNumber 5), - (lightSource, ExifNumber 0), - (flash, ExifNumber 24), - (focalLength, ExifRational 0 10), - (flashPixVersion, ExifUndefined "0100"), - (colorSpace, ExifNumber 1), - (sceneType, ExifUndefined "\SOH"), - (exifImageWidth, ExifNumber 1), - (exifImageHeight, ExifNumber 1), - (exifInteroperabilityOffset, ExifNumber 36616), - (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), - (userComment, ExifUndefined "UNICODE\NULT\NULe\NULs\NULt\NUL \NULE\NULx\NULi\NULf\NUL \NULc\NULo\NULm\NULm\NULe\NULn\NULt\NUL\r\SOHa\SOH~\SOH"), - (dateTime, ExifText "2014:04:10 20:14:20"), - (yCbCrPositioning, ExifNumber 2), - (fileSource, ExifUndefined "\ETX"), - (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\NUL") - ]) (sort $ Map.toList cleanedParsed) - -- the sony maker note is 35k!! Just test its size and that it starts with "SONY DSC". - assertEqual' 35692 (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,_) -> (a/=makerNote)) $ Map.toList parsed - makerNoteV = (\(Just (ExifUndefined x)) -> x) $ Map.lookup makerNote parsed + case cleanedParsedM of + Nothing -> assertBool "Parsing fails" False + Just cleanedParsed -> assertEqualListDebug + (sort [ + (exposureTime, ExifRational 1 160), + (fnumber, ExifRational 0 10), + (exposureProgram, ExifNumber 2), + (isoSpeedRatings, ExifNumber 1600), + (exifVersion, ExifUndefined "0230"), + (dateTimeOriginal, ExifText "2013:10:02 20:33:33"), + (dateTimeDigitized, ExifText "2013:10:02 20:33:33"), + (componentConfiguration, ExifUndefined "\SOH\STX\ETX\NUL"), + (compressedBitsPerPixel, ExifRational 2 1), + (brightnessValue, ExifRational (-4226) 2560), + (exposureBiasValue, ExifRational 0 10), + (maxApertureValue, ExifRational 0 10), + (meteringMode, ExifNumber 5), + (lightSource, ExifNumber 0), + (flash, ExifNumber 24), + (focalLength, ExifRational 0 10), + (flashPixVersion, ExifUndefined "0100"), + (colorSpace, ExifNumber 1), + (sceneType, ExifUndefined "\SOH"), + (exifImageWidth, ExifNumber 1), + (exifImageHeight, ExifNumber 1), + (exifInteroperabilityOffset, ExifNumber 36616), + (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), + (userComment, ExifUndefined "UNICODE\NULT\NULe\NULs\NULt\NUL \NULE\NULx\NULi\NULf\NUL \NULc\NULo\NULm\NULm\NULe\NULn\NULt\NUL\r\SOHa\SOH~\SOH"), + (dateTime, ExifText "2014:04:10 20:14:20"), + (yCbCrPositioning, ExifNumber 2), + (fileSource, ExifUndefined "\ETX"), + (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\NUL") + ]) (sort cleanedParsed) + -- the sony maker note is 35k!! Just test its size and that it starts with "SONY DSC". + assertEqual' (Just 35692) (BS.length <$> makerNoteV) + assertEqual' (Just "SONY DSC") (take 8 <$> fmap (chr . fromIntegral) <$> BS.unpack <$> makerNoteV) + where + -- the makerNote is HUGE. so test it separately. + parsed = hush $ parseExif imageContents + cleanedParsedM = filter ((/=makerNote) . fst) <$> (Map.toList <$> parsed) + makerNoteV = parsed >>= Map.lookup makerNote >>= getUndefMaybe -testDate :: Map ExifTag ExifValue -> Spec +getUndefMaybe :: ExifValue -> Maybe BS.ByteString +getUndefMaybe (ExifUndefined x) = Just x +getUndefMaybe _ = Nothing + +testDate :: Maybe (Map ExifTag ExifValue) -> Spec testDate exifData = it "extracts the date correctly" $ - assertEqual' (Just $ LocalTime (fromGregorian 2013 10 2) (TimeOfDay 20 33 33)) - (getDateTimeOriginal exifData) + assertEqual' (Just $ LocalTime (fromGregorian 2013 10 2) (TimeOfDay 20 33 33)) + (exifData >>= getDateTimeOriginal) -testOrientation :: Map ExifTag ExifValue -> Spec +testOrientation :: Maybe (Map ExifTag ExifValue) -> Spec testOrientation exifData = it "reads exif orientation" $ - assertEqual' (Just Normal) $ getOrientation exifData + assertEqual' (Just Normal) $ exifData >>= getOrientation testReadExifDateTime :: Spec testReadExifDateTime = it "reads exif date time" $ do - assertEqual' (Just $ LocalTime (fromGregorian 2013 10 2) (TimeOfDay 20 33 33)) (readExifDateTime "2013:10:02 20:33:33") - assertEqual' Nothing (readExifDateTime "2013:10:02 20:33:3") + assertEqual' (Just $ LocalTime (fromGregorian 2013 10 2) (TimeOfDay 20 33 33)) (readExifDateTime "2013:10:02 20:33:33") + assertEqual' Nothing (readExifDateTime "2013:10:02 20:33:3") -testReadGpsLatLong :: Map ExifTag ExifValue -> Spec +testReadGpsLatLong :: Maybe (Map ExifTag ExifValue) -> Spec testReadGpsLatLong exifData = it "reads gps latitude longitude" $ do - let (Just (lat,long)) = getGpsLatitudeLongitude exifData - assertBool' $ 50.2179 < lat && 50.2180 > lat - assertBool' $ -5.031 > long && -5.032 < long + let (Just (lat,long)) = exifData >>= getGpsLatitudeLongitude + assertBool' $ 50.2179 < lat && 50.2180 > lat + assertBool' $ -5.031 > long && -5.032 < long -testReadGpsLatLongNoData :: Map ExifTag ExifValue -> Spec +testReadGpsLatLongNoData :: Maybe (Map ExifTag ExifValue) -> Spec testReadGpsLatLongNoData exifData = it "reads gps latitude longitude" $ - assertEqual' Nothing $ getGpsLatitudeLongitude exifData + assertEqual' Nothing $ join $ getGpsLatitudeLongitude <$> exifData testFormatAsFloatingPoint :: Spec testFormatAsFloatingPoint = it "properly formats as floating point" $ do - assertEqual' "0.75" $ formatAsFloatingPoint 2 $ ExifRational 3 4 - assertEqual' "0.75, -0.50, 0.25" $ formatAsFloatingPoint 2 $ ExifRationalList [(3,4),(-1,2),(1,4)] + assertEqual' "0.75" $ formatAsFloatingPoint 2 $ ExifRational 3 4 + assertEqual' "0.75, -0.50, 0.25" $ formatAsFloatingPoint 2 $ ExifRationalList [(3,4),(-1,2),(1,4)] -testPrettyPrint :: Map ExifTag ExifValue -> Map ExifTag ExifValue -> Map ExifTag ExifValue -> Spec +testPrettyPrint :: Maybe (Map ExifTag ExifValue) + -> Maybe (Map ExifTag ExifValue) + -> Maybe (Map ExifTag ExifValue) -> Spec testPrettyPrint exifData stdExifData gps2ExifData = it "pretty prints many tags properly" $ do - checkPrettyPrinter orientation "Top-left" exifData - checkPrettyPrinter flash "Flash did not fire, auto mode" exifData - checkPrettyPrinter exposureTime "1/200 sec." exifData - checkPrettyPrinter maxApertureValue "f/2.0" exifData - checkPrettyPrinter exposureProgram "Normal program" exifData - checkPrettyPrinter exifVersion "Exif version 2.30" exifData - checkPrettyPrinter componentConfiguration "YCbCr-" exifData - checkPrettyPrinter exposureBiasValue "0.00 EV" exifData - checkPrettyPrinter meteringMode "Pattern" exifData - checkPrettyPrinter lightSource "Unknown" exifData - checkPrettyPrinter flashPixVersion "FlashPix version 1.0" exifData - checkPrettyPrinter colorSpace "sRGB" exifData - checkPrettyPrinter customRendered "Normal process" exifData - checkPrettyPrinter exposureMode "Auto exposure" exifData - checkPrettyPrinter whiteBalance "Auto white balance" exifData - checkPrettyPrinter sceneCaptureType "Standard" exifData - checkPrettyPrinter gainControl "Normal" exifData - checkPrettyPrinter contrast "Normal" exifData - checkPrettyPrinter saturation "Normal" exifData - checkPrettyPrinter resolutionUnit "Inch" exifData - checkPrettyPrinter yCbCrPositioning "Co-sited" exifData - checkPrettyPrinter gpsLatitude "50° 13' 4.50\"" exifData - checkPrettyPrinter gpsLatitudeRef "North" exifData - checkPrettyPrinter gpsAltitude "2681.1111" gps2ExifData - checkPrettyPrinter gpsTimeStamp "09:12:32.21" gps2ExifData - checkPrettyPrinter userComment "Test Exif comment" exifData - checkPrettyPrinter userComment "Test Exif commentčšž" stdExifData + checkPrettyPrinter orientation "Top-left" exifData + checkPrettyPrinter flash "Flash did not fire, auto mode" exifData + checkPrettyPrinter exposureTime "1/200 sec." exifData + checkPrettyPrinter maxApertureValue "f/2.0" exifData + checkPrettyPrinter exposureProgram "Normal program" exifData + checkPrettyPrinter exifVersion "Exif version 2.30" exifData + checkPrettyPrinter componentConfiguration "YCbCr-" exifData + checkPrettyPrinter exposureBiasValue "0.00 EV" exifData + checkPrettyPrinter meteringMode "Pattern" exifData + checkPrettyPrinter lightSource "Unknown" exifData + checkPrettyPrinter flashPixVersion "FlashPix version 1.0" exifData + checkPrettyPrinter colorSpace "sRGB" exifData + checkPrettyPrinter customRendered "Normal process" exifData + checkPrettyPrinter exposureMode "Auto exposure" exifData + checkPrettyPrinter whiteBalance "Auto white balance" exifData + checkPrettyPrinter sceneCaptureType "Standard" exifData + checkPrettyPrinter gainControl "Normal" exifData + checkPrettyPrinter contrast "Normal" exifData + checkPrettyPrinter saturation "Normal" exifData + checkPrettyPrinter resolutionUnit "Inch" exifData + checkPrettyPrinter yCbCrPositioning "Co-sited" exifData + checkPrettyPrinter gpsLatitude "50° 13' 4.50\"" exifData + checkPrettyPrinter gpsLatitudeRef "North" exifData + checkPrettyPrinter gpsAltitude "2681.1111" gps2ExifData + checkPrettyPrinter gpsTimeStamp "09:12:32.21" gps2ExifData + checkPrettyPrinter userComment "Test Exif comment" exifData + checkPrettyPrinter userComment "Test Exif commentčšž" stdExifData -checkPrettyPrinter :: ExifTag -> Text -> Map ExifTag ExifValue -> Assertion -checkPrettyPrinter tag str exifData = assertEqual' (Just str) $ prettyPrinter tag <$> Map.lookup tag exifData +checkPrettyPrinter :: ExifTag -> Text -> Maybe (Map ExifTag ExifValue) -> Assertion +checkPrettyPrinter tag str exifData = assertEqual' (Just str) $ prettyPrinter tag <$> (exifData >>= Map.lookup tag) -testFlashFired :: Map ExifTag ExifValue -> Spec +testFlashFired :: Maybe (Map ExifTag ExifValue) -> Spec testFlashFired exifData = it "properly reads whether the flash was fired" $ do - assertEqual' (Just False) $ wasFlashFired exifData - assertEqual' Nothing $ wasFlashFired Map.empty - assertEqual' (Just False) $ wasFlashFired $ makeExifMapWithFlash 0 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 1 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 5 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 7 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 9 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x0D - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x0F - assertEqual' (Just False) $ wasFlashFired $ makeExifMapWithFlash 0x10 - assertEqual' (Just False) $ wasFlashFired $ makeExifMapWithFlash 0x18 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x19 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x1D - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x1F - assertEqual' (Just False) $ wasFlashFired $ makeExifMapWithFlash 0x20 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x41 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x45 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x47 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x4D - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x4F - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x59 - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x5D - assertEqual' (Just True) $ wasFlashFired $ makeExifMapWithFlash 0x5F + assertEqual' (Just False) $ exifData >>= wasFlashFired + assertEqual' Nothing $ wasFlashFired Map.empty + let check (ex, val) = Just ex == wasFlashFired (makeExifMapWithFlash val) + assertBool "a number test fails" $ all check [ + (False, 0), (True, 1), (True, 5), (True, 7), (True, 9), (True, 0x0D), + (True, 0x0F), (False, 0x10), (False, 0x18), (True, 0x19), (True, 0x1D), + (True, 0x1F), (False, 0x20), (True, 0x41), (True, 0x45), (True, 0x47), + (True, 0x4D), (True, 0x4F), (True, 0x59), (True, 0x5D), (True, 0x5F)] makeExifMapWithFlash :: Int -> Map ExifTag ExifValue makeExifMapWithFlash flashV = Map.fromList [(flash, ExifNumber flashV)] testPartialExif :: B.ByteString -> Spec -testPartialExif imageContents = it "parses a partial exif JPEG" $ do - assertEqualListDebug [] (Map.toList parsed) - where - parsed = (\(Right x) -> x) $ parseExif imageContents +testPartialExif imageContents = it "parses a partial exif JPEG" $ + assertEqual' (Right []) (Map.toList <$> parseExif imageContents) assertEqualListDebug :: (Show a, Eq a) => [a] -> [a] -> Assertion assertEqualListDebug = assertEqualListDebug' (0 :: Int) - where - assertEqualListDebug' idx (x:xs) (y:ys) = do - assertEqual ("index " ++ show idx ++ " differs: " ++ show x ++ " /= " ++ show y) x y - assertEqualListDebug' (idx+1) xs ys - assertEqualListDebug' _ (x:_) [] = assertBool ("List lengths differ, expected " ++ show x) False - assertEqualListDebug' _ [] (y:_) = assertBool ("List lengths differ, got " ++ show y) False - assertEqualListDebug' _ [] [] = assertBool "" True + where + assertEqualListDebug' idx (x:xs) (y:ys) = do + assertEqual ("index " ++ show idx ++ " differs: " ++ show x ++ " /= " ++ show y) x y + assertEqualListDebug' (idx+1) xs ys + assertEqualListDebug' _ (x:_) [] = assertBool ("List lengths differ, expected " ++ show x) False + assertEqualListDebug' _ [] (y:_) = assertBool ("List lengths differ, got " ++ show y) False + assertEqualListDebug' _ [] [] = assertBool "" True assertEqual' :: (Show a, Eq a) => a -> a -> Assertion assertEqual' = assertEqual "doesn't match"