diff --git a/Graphics/ExifTags.hs b/Graphics/ExifTags.hs --- a/Graphics/ExifTags.hs +++ b/Graphics/ExifTags.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Graphics.ExifTags where @@ -5,134 +6,143 @@ import Text.Printf (printf) import qualified Data.Map as Map import Data.Map (Map) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar +import Data.Time.LocalTime +import Data.Binary.Get import Graphics.Types import Graphics.PrettyPrinters +import Graphics.Helpers -exifSubIfdTag :: String -> Word16 -> (ExifValue -> String)-> ExifTag +exifSubIfdTag :: String -> Word16 -> (ExifValue -> Text)-> ExifTag exifSubIfdTag d = ExifTag ExifSubIFD (Just d) -exifIfd0Tag :: String -> Word16 -> (ExifValue -> String) -> ExifTag +exifIfd0Tag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag exifIfd0Tag d = ExifTag IFD0 (Just d) -exifGpsTag :: String -> Word16 -> (ExifValue -> String) -> ExifTag +exifGpsTag :: String -> Word16 -> (ExifValue -> Text) -> ExifTag exifGpsTag d = ExifTag GpsSubIFD (Just d) -withFormat :: String -> ExifValue -> String -withFormat fmt = printf fmt . show +withFormat :: String -> ExifValue -> Text +withFormat fmt = T.pack . printf fmt . show -asFpWithFormat :: String -> ExifValue -> String -asFpWithFormat fmt = printf fmt . formatAsFloatingPoint 2 +asFpWithFormat :: String -> ExifValue -> Text +asFpWithFormat fmt = T.pack . printf fmt . formatAsFloatingPoint 2 +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 show -isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 show -oecf = exifSubIfdTag "OECF" 0x8828 show +spectralSensitivity = exifSubIfdTag "spectralSensitivity" 0x8824 showT +isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 showT +oecf = exifSubIfdTag "OECF" 0x8828 showT exifVersion = exifSubIfdTag "exifVersion" 0x9000 ppExifVersion -dateTimeOriginal = exifSubIfdTag "dateTimeOriginal" 0x9003 show -dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 show +dateTimeOriginal = exifSubIfdTag "dateTimeOriginal" 0x9003 showT +dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 showT componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 ppComponentConfiguration -compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (formatAsFloatingPoint 2) +compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (T.pack . formatAsFloatingPoint 2) shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ withFormat "%s sec." -apertureValue = exifSubIfdTag "apertureValue" 0x9202 show -brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 show +apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppAperture +brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 showT exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 $ asFpWithFormat "%s EV" -maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 $ withFormat "f/%s" -subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 show +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 show -makerNote = exifSubIfdTag "makerNote" 0x927c show -userComment = exifSubIfdTag "userComment" 0x9286 show -subSecTime = exifSubIfdTag "subSecTime" 0x9290 show -subSecTimeOriginal = exifSubIfdTag "subSecTimeOriginal" 0x9291 show -subSecTimeDigitized = exifSubIfdTag "subSecTimeDigitized" 0x9292 show +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 show -exifImageHeight = exifSubIfdTag "exifImageHeight" 0xa003 show -relatedSoundFile = exifSubIfdTag "relatedSoundFile" 0xa004 show -flashEnergy = exifSubIfdTag "flashEnergy" 0xa20b show -spatialFrequencyResponse= exifSubIfdTag "spatialFrequencyResponse" 0xa20c show -focalPlaneXResolution = exifSubIfdTag "focalPlaneXResolution" 0xa20e show -focalPlaneYResolution = exifSubIfdTag "focalPlaneYResolution" 0xa20f show +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 focalPlaneResolutionUnit= exifSubIfdTag "focalPlaneResolutionUnit" 0xa210 ppFocalPlaneResolutionUnit -subjectLocation = exifSubIfdTag "subjectLocation" 0xa214 show -exposureIndex = exifSubIfdTag "exposureIndex" 0xa215 show +subjectLocation = exifSubIfdTag "subjectLocation" 0xa214 showT +exposureIndex = exifSubIfdTag "exposureIndex" 0xa215 showT sensingMethod = exifSubIfdTag "sensingMethod" 0xa217 ppSensingMethod -fileSource = exifSubIfdTag "fileSource" 0xa300 show +fileSource = exifSubIfdTag "fileSource" 0xa300 showT sceneType = exifSubIfdTag "sceneType" 0xa301 ppSceneType -cfaPattern = exifSubIfdTag "cfaPattern" 0xa302 show +cfaPattern = exifSubIfdTag "cfaPattern" 0xa302 showT customRendered = exifSubIfdTag "customRendered" 0xa401 ppCustomRendered exposureMode = exifSubIfdTag "exposureMode" 0xa402 ppExposureMode whiteBalance = exifSubIfdTag "whiteBalance" 0xa403 ppWhiteBalance -digitalZoomRatio = exifSubIfdTag "digitalZoomRatio" 0xa404 show +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 show +deviceSettingDescription= exifSubIfdTag "deviceSettingDescription" 0xa40b showT subjectDistanceRange = exifSubIfdTag "subjectDistanceRange" 0xa40c ppSubjectDistanceRange -imageUniqueId = exifSubIfdTag "imageUniqueId" 0xa420 show -exifInteroperabilityOffset=exifSubIfdTag "exifInteroperabilityOffset" 0xa005 show +imageUniqueId = exifSubIfdTag "imageUniqueId" 0xa420 showT +exifInteroperabilityOffset=exifSubIfdTag "exifInteroperabilityOffset" 0xa005 showT -imageDescription = exifIfd0Tag "imageDescription" 0x010e show -make = exifIfd0Tag "make" 0x010f show -model = exifIfd0Tag "model" 0x0110 show +imageDescription = exifIfd0Tag "imageDescription" 0x010e showT +make = exifIfd0Tag "make" 0x010f showT +model = exifIfd0Tag "model" 0x0110 showT orientation = exifIfd0Tag "orientation" 0x0112 ppOrientation -xResolution = exifIfd0Tag "xResolution" 0x011a show -yResolution = exifIfd0Tag "xResolution" 0x011b show +xResolution = exifIfd0Tag "xResolution" 0x011a showT +yResolution = exifIfd0Tag "xResolution" 0x011b showT resolutionUnit = exifIfd0Tag "resolutionUnit" 0x0128 ppResolutionUnit -software = exifIfd0Tag "software" 0x0131 show -dateTime = exifIfd0Tag "dateTime" 0x0132 show -artist = exifIfd0Tag "artist" 0x013b show -whitePoint = exifIfd0Tag "whitePoint" 0x013e show -primaryChromaticities = exifIfd0Tag "primaryChromaticities" 0x013f show -yCbCrCoefficients = exifIfd0Tag "yCbCrCoefficients" 0x0211 show +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 show -copyright = exifIfd0Tag "copyright" 0x8298 show -exifIfdOffset = exifIfd0Tag "exifIfdOffset" 0x8769 show -gpsTagOffset = exifIfd0Tag "gpsTagOffset" 0x8825 show -printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 show +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 show -gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 show +gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 showT +gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 showT gpsLatitude = exifGpsTag "gpsLatitude" 0x0002 ppGpsLongLat -gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 show +gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 showT gpsLongitude = exifGpsTag "gpsLongitude" 0x0004 ppGpsLongLat gpsAltitudeRef = exifGpsTag "gpsAltitudeRef" 0x0005 ppGpsAltitudeRef -gpsAltitude = exifGpsTag "gpsAltitude" 0x0006 show -gpsTimeStamp = exifGpsTag "gpsTimeStamp" 0x0007 show -gpsSatellites = exifGpsTag "gpsSatellites" 0x0008 show -gpsStatus = exifGpsTag "gpsStatus" 0x0009 show -gpsMeasureMode = exifGpsTag "gpsMeasureMode" 0x000a show -gpsDop = exifGpsTag "gpsDop" 0x000b show -gpsSpeedRef = exifGpsTag "gpsSpeedRef" 0x000c show -gpsSpeed = exifGpsTag "gpsSpeed" 0x000d show -gpsTrackRef = exifGpsTag "gpsTrackRef" 0x000e show -gpsTrack = exifGpsTag "gpsTrack" 0x000f show -gpsImgDirectionRef = exifGpsTag "gpsImgDirectionRef" 0x0010 show -gpsImgDirection = exifGpsTag "gpsImgDirection" 0x0011 show -gpsMapDatum = exifGpsTag "gpsMapDatum" 0x0012 show -gpsDestLatitudeRef = exifGpsTag "gpsDestLatitudeRef" 0x0013 show -gpsDestLatitude = exifGpsTag "gpsDestLatitude" 0x0014 show -gpsDestLongitudeRef = exifGpsTag "gpsDestLongitudeRef" 0x0015 show -gpsDestLongitude = exifGpsTag "gpsDestLongitude" 0x0016 show -gpsDestBearingRef = exifGpsTag "gpsDestBearingRef" 0x0017 show -gpsDestBearing = exifGpsTag "gpsDestBearing" 0x0018 show -gpsDestDistanceRef = exifGpsTag "gpsDestDistanceRef" 0x0019 show -gpsDestDistance = exifGpsTag "gpsDestDistance" 0x001a show -gpsProcessingMethod = exifGpsTag "gpsProcessingMethod" 0x001b show -gpsAreaInformation = exifGpsTag "gpsAreaInformation" 0x001c show -gpsDateStamp = exifGpsTag "gpsDateStamp" 0x001d show -gpsDifferential = exifGpsTag "gpsDifferential" 0x001e show +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, @@ -185,6 +195,38 @@ intPairToFloating (n, d) = fromIntegral n / fromIntegral d gpsDecodeToDecimalDegrees _ = Nothing -ppGpsLongLat :: ExifValue -> String +ppGpsLongLat :: ExifValue -> Text ppGpsLongLat v = maybe "invalid GPS data" fmt $ gpsDecodeToDecimalDegrees v - where fmt = printf "%.6f" + where fmt = T.pack . printf "%.6f" + +-- | 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 + +parseGpsDate :: ExifValue -> Maybe Day +parseGpsDate (ExifText dateStr) = runMaybeGet getExifDate $ stringToByteString dateStr +parseGpsDate _ = Nothing + +getExifDate :: Get Day +getExifDate = do + 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) +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) + +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 diff --git a/Graphics/Helpers.hs b/Graphics/Helpers.hs new file mode 100644 --- /dev/null +++ b/Graphics/Helpers.hs @@ -0,0 +1,37 @@ +module Graphics.Helpers where + +import Data.Binary.Get +import qualified Data.ByteString.Lazy as B +import Control.Monad (liftM, replicateM) +import Data.Char (chr, isDigit, ord) + +-- i had this as runGetM and reusing in parseExif, +-- sadly fail is not implemented for Either. +-- will do for now. +runMaybeGet :: Get a -> B.ByteString -> Maybe a +runMaybeGet get bs = case runGetOrFail get bs of + Left _ -> Nothing + Right (_,_,x) -> Just x + +getCharWhere :: (Char->Bool) -> Get Char +getCharWhere wher = do + char <- liftM (chr . fromIntegral) getWord8 + if wher char + then return char + else fail "no parse" + +getDigit :: Get Char +getDigit = getCharWhere isDigit + +getCharValue :: Char -> Get Char +getCharValue char = getCharWhere (==char) + +readDigit :: Read a => Int -> Get a +readDigit x = liftM read $ count x getDigit + +count :: Int -> Get a -> Get [a] +count n p | n <= 0 = return [] + | otherwise = replicateM n p + +stringToByteString :: String -> B.ByteString +stringToByteString str = B.pack $ map (fromIntegral . ord) str diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -16,6 +16,8 @@ getGpsLatitudeLongitude, wasFlashFired, formatAsFloatingPoint, + getGpsDateTime, + parseGpsTime, -- * The ExifValue type ExifValue(..), @@ -143,10 +145,10 @@ import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString.Lazy as B -import Control.Monad (liftM, unless, replicateM) +import Control.Monad (liftM, unless) import qualified Data.ByteString.Char8 as Char8 import Data.Word -import Data.Char (isDigit, ord, chr) +import Data.Char (ord) import Data.Int (Int32, Int16, Int8) import Data.List import Data.Maybe (fromMaybe, fromJust) -- TODO try to get rid of fromJust @@ -158,6 +160,7 @@ import Graphics.Types (ExifValue(..), ExifTag(..), TagLocation(..), formatAsFloatingPoint) import Graphics.ExifTags +import Graphics.Helpers -- see http://www.media.mit.edu/pia/Research/deepview/exif.html -- and http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf @@ -288,7 +291,7 @@ } getExifTag :: TagLocation -> Word16 -> ExifTag -getExifTag l v = fromMaybe (ExifTag l Nothing v show) $ find (isSameTag l v) allExifTags +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 data ValueHandler = ValueHandler @@ -362,7 +365,7 @@ dataTypeId = 7, dataLength = 1, readSingle = \ba -> readMany undefinedValueHandler ba 1, - readMany = \_ components -> liftM ExifUndefined (getByteString (components-1)) + readMany = \_ components -> liftM ExifUndefined (getByteString components) } signedShortValueHandler = ValueHandler @@ -458,14 +461,6 @@ 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. --- will do for now. -runMaybeGet :: Get a -> B.ByteString -> Maybe a -runMaybeGet get bs = case runGetOrFail get bs of - Left _ -> Nothing - Right (_,_,x) -> Just x - -- | Decode an EXIF date time value. -- Will return 'Nothing' in case parsing fails. readExifDateTime :: String -> Maybe LocalTime @@ -484,31 +479,11 @@ -- 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) - where - readDigit x = liftM read $ count x getDigit - -count :: Int -> Get a -> Get [a] -count n p | n <= 0 = return [] - | otherwise = replicateM n p - -- | 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 - -getCharWhere :: (Char->Bool) -> Get Char -getCharWhere wher = do - char <- liftM (chr . fromIntegral) getWord8 - if wher char - then return char - else fail "no parse" - -getDigit :: Get Char -getDigit = getCharWhere isDigit - -getCharValue :: Char -> Get Char -getCharValue char = getCharWhere (==char) data RotationDirection = MinusNinety | Ninety diff --git a/Graphics/PrettyPrinters.hs b/Graphics/PrettyPrinters.hs --- a/Graphics/PrettyPrinters.hs +++ b/Graphics/PrettyPrinters.hs @@ -1,23 +1,36 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} module Graphics.PrettyPrinters where -import Graphics.Types (ExifValue(..)) import Data.List (foldl') import Text.Printf (printf) import qualified Data.Map as Map -import Data.Char (chr) import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL import Control.Arrow (first) +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text as T +import Data.Text (Text) +import Codec.Text.IConv (convertFuzzy, EncodingName, Fuzzy(Transliterate)) -ppResolutionUnit :: ExifValue -> String +import Graphics.Types (ExifValue(..), formatAsFloatingPoint) + +-- ! Pretty print the undefined data +ppUndef :: ExifValue -> Text +ppUndef (ExifUndefined str) = T.pack (show $ BS.length str) `T.append` " bytes undefined data" +ppUndef _ = "undefined data" + +ppResolutionUnit :: ExifValue -> Text ppResolutionUnit = fromNumberMap [(1, "No absolute unit"), (2, "Inch"), (3, "Centimeter")] -ppYCbCrPositioning :: ExifValue -> String +ppYCbCrPositioning :: ExifValue -> Text ppYCbCrPositioning = fromNumberMap [(1, "Centered"), (2, "Co-sited")] -ppExposureProgram :: ExifValue -> String +ppAperture :: ExifValue -> Text +ppAperture = T.pack . printf "f/%s" . formatAsFloatingPoint 1 + +ppExposureProgram :: ExifValue -> Text ppExposureProgram = fromNumberMap [(0, "Not defined"), (1, "Manual"), (2, "Normal program"), @@ -28,7 +41,7 @@ (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 -> String +ppMeteringMode :: ExifValue -> Text ppMeteringMode = fromNumberMap [(0, "Unknown"), (1, "Average"), (2, "Center-weighted average"), @@ -38,7 +51,7 @@ (6, "Partial"), (255, "other")] -ppLightSource :: ExifValue -> String +ppLightSource :: ExifValue -> Text ppLightSource = fromNumberMap [(0, "Unknown"), (1, "Daylight"), (2, "Fluorescent"), @@ -61,7 +74,7 @@ (24, "ISO studio tungsten"), (255, "Other light source")] -ppFlash :: ExifValue -> String +ppFlash :: ExifValue -> Text ppFlash = fromNumberMap [(0, "Flash did not fire"), (1, "Flash fired"), (5, "Strobe return light not detected"), @@ -85,43 +98,43 @@ (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 -> String +ppColorSpace :: ExifValue -> Text ppColorSpace = fromNumberMap [(1, "sRGB"), (65535, "Uncalibrated")] -ppCustomRendered :: ExifValue -> String +ppCustomRendered :: ExifValue -> Text ppCustomRendered = fromNumberMap [(0, "Normal process"), (1, "Custom process")] -ppExposureMode :: ExifValue -> String +ppExposureMode :: ExifValue -> Text ppExposureMode = fromNumberMap [(0, "Auto exposure"), (1, "Manual exposure"), (2, "Auto bracket")] -ppWhiteBalance :: ExifValue -> String +ppWhiteBalance :: ExifValue -> Text ppWhiteBalance = fromNumberMap [(0, "Auto white balance"), (1, "Manual white balance")] -ppSceneCaptureType :: ExifValue -> String +ppSceneCaptureType :: ExifValue -> Text ppSceneCaptureType = fromNumberMap [(0, "Standard"), (1, "Landscape"), (2, "Portrait"), (3, "Night scene")] -ppGainControl :: ExifValue -> String +ppGainControl :: ExifValue -> Text ppGainControl = fromNumberMap [(0, "Normal"), (1, "Low gain up"), (2, "High gain up"), (3, "Low gain down"), (4, "High gain down")] -ppContrastSharpness :: ExifValue -> String +ppContrastSharpness :: ExifValue -> Text ppContrastSharpness = fromNumberMap [(0, "Normal"), (1, "Soft"), (2, "Hard")] -ppSaturation :: ExifValue -> String +ppSaturation :: ExifValue -> Text ppSaturation = fromNumberMap [(0, "Normal"), (1, "Low saturation"), (2, "High saturation")] -ppSensingMethod :: ExifValue -> String +ppSensingMethod :: ExifValue -> Text ppSensingMethod = fromNumberMap [(1, "Not defined"), (2, "One-chip color area sensor"), (3, "Two-chip color area sensor"), @@ -130,18 +143,18 @@ (7, "Trilinear sensor"), (8, "Color sequential linear sensor")] -ppSubjectDistanceRange :: ExifValue -> String +ppSubjectDistanceRange :: ExifValue -> Text ppSubjectDistanceRange = fromNumberMap [(0, "Unknown"), (1, "Macro"), (2, "Close view"), (3, "Distance view")] -ppFocalPlaneResolutionUnit :: ExifValue -> String +ppFocalPlaneResolutionUnit :: ExifValue -> Text ppFocalPlaneResolutionUnit = fromNumberMap [(1, "No absolute unit of measurement"), (2, "Inch"), (3, "Centimeter")] -ppOrientation :: ExifValue -> String +ppOrientation :: ExifValue -> Text ppOrientation = fromNumberMap [(1, "Top-left"), (2, "Top-right"), (3, "Bottom-right"), @@ -151,15 +164,15 @@ (7, "Right-bottom"), (8, "Left-bottom")] -ppSceneType :: ExifValue -> String +ppSceneType :: ExifValue -> Text ppSceneType = fromNumberMap [(1, "Directly photographed")] -ppGpsAltitudeRef :: ExifValue -> String +ppGpsAltitudeRef :: ExifValue -> Text ppGpsAltitudeRef = fromNumberMap [(0, "Sea level"), (1, "Below sea level")] -ppComponentConfiguration :: ExifValue -> String -ppComponentConfiguration (ExifUndefined bs) = foldl' addComponent [] numbers +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 @@ -174,25 +187,36 @@ _ -> "?" ppComponentConfiguration v@_ = unknown v -ppFlashPixVersion :: ExifValue -> String +ppFlashPixVersion :: ExifValue -> Text ppFlashPixVersion = formatVersion "FlashPix version %.1f" -ppExifVersion :: ExifValue -> String +ppExifVersion :: ExifValue -> Text ppExifVersion = formatVersion "Exif version %.2f" -formatVersion :: String -> ExifValue -> String -formatVersion fmt (ExifUndefined s) = printf fmt num +formatVersion :: String -> ExifValue -> Text +formatVersion fmt (ExifUndefined s) = T.pack $ printf fmt num where - num :: Float = read asStr / 10.0 - asStr = fmap (chr . fromIntegral) $ BS.unpack s + num :: Float = read asStr / 100.0 + asStr = T.unpack $ decodeUtf8 s formatVersion _ v@_ = unknown v -fromNumberMap :: [(Int, String)] -> ExifValue -> String +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 +ppUserComment v@_ = unknown v + +getIconvEncodingName :: Text -> EncodingName +getIconvEncodingName "JIS" = "SJIS" +getIconvEncodingName x@_ = T.unpack x -- ASCII and UNICODE work out of the box. + +fromNumberMap :: [(Int, Text)] -> ExifValue -> Text fromNumberMap m = fromMap convertedMap where convertedMap = fmap (first ExifNumber) m -fromMap :: [(ExifValue, String)] -> ExifValue -> String +fromMap :: [(ExifValue, Text)] -> ExifValue -> Text fromMap m v = Map.findWithDefault (unknown v) v $ Map.fromList m -unknown :: Show a => a -> String -unknown v = "Unknown value: " ++ show v +unknown :: Show a => a -> Text +unknown v = T.pack $ "Unknown value: " ++ show v diff --git a/Graphics/Types.hs b/Graphics/Types.hs --- a/Graphics/Types.hs +++ b/Graphics/Types.hs @@ -6,6 +6,7 @@ import Data.Function (on) import Data.List import Text.Printf (printf) +import Data.Text (Text) -- | An exif value. -- @@ -72,7 +73,7 @@ -- or compare the tagKey. tagKey :: Word16, -- ^ Exif tag key, the number uniquely identifying this tag. - prettyPrinter :: ExifValue -> String + 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. 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.5.0.3 +version: 0.6.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. @@ -19,13 +19,15 @@ library exposed-modules: Graphics.HsExif - other-modules: Graphics.Types, Graphics.PrettyPrinters, Graphics.ExifTags + other-modules: Graphics.Types, Graphics.PrettyPrinters, Graphics.ExifTags, Graphics.Helpers -- 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.5, + iconv >= 0.4 && <0.5, + text >= 0.9 -- hs-source-dirs: default-language: Haskell2010 Ghc-Options: -Wall @@ -41,5 +43,7 @@ binary >=0.7 && <0.8, bytestring >=0.10 && <0.11, containers >= 0.5 && <0.6, - time >= 1.4 && <1.5 + time >= 1.4 && <1.5, + 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 @@ -2,25 +2,30 @@ import Test.Hspec import Test.HUnit -import Graphics.HsExif import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as BS +import Data.Text (Text) import qualified Data.Map as Map import Data.Map (Map) import Data.Time.LocalTime import Data.Time.Calendar import Data.Char (chr) import Control.Monad (liftM) +import Data.List +import Graphics.HsExif + 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" 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 @@ -31,7 +36,7 @@ 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 + describe "pretty printing" $ testPrettyPrint gpsExifData exifData gps2ExifData describe "flash fired" $ testFlashFired exifData testNotAJpeg :: B.ByteString -> Spec @@ -44,33 +49,30 @@ testBasic :: B.ByteString -> Spec testBasic imageContents = it "parses a simple JPEG" $ do - assertEqual' - (Map.fromList - [ + assertEqualListDebug + (sort [ (exposureTime, ExifRational 1 160), (fnumber, ExifRational 0 10), (exposureProgram, ExifNumber 2), (isoSpeedRatings, ExifNumber 1600), - (exifVersion, ExifUndefined "023"), + (exifVersion, ExifUndefined "0230"), (dateTimeOriginal, ExifText "2013:10:02 20:33:33"), (dateTimeDigitized, ExifText "2013:10:02 20:33:33"), - (componentConfiguration, ExifUndefined "\SOH\STX\ETX"), + (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), - (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"), + (flashPixVersion, ExifUndefined "0100"), (colorSpace, ExifNumber 1), - (sceneType, ExifUndefined ""), + (sceneType, ExifUndefined "\SOH"), (exifImageWidth, ExifNumber 1), (exifImageHeight, ExifNumber 1), - (exifInteroperabilityOffset, ExifNumber 36640), + (exifInteroperabilityOffset, ExifNumber 36616), (customRendered, ExifNumber 0), (exposureMode, ExifNumber 0), (whiteBalance, ExifNumber 0), @@ -88,13 +90,15 @@ (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") - ]) cleanedParsed + (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' 35698 (BS.length makerNoteV) + 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. @@ -131,14 +135,15 @@ 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 -> Spec -testPrettyPrint exifData = it "pretty prints many tags properly" $ do +testPrettyPrint :: Map ExifTag ExifValue -> Map ExifTag ExifValue -> 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 componentConfiguration "YCbCr-" exifData checkPrettyPrinter exposureBiasValue "0.00 EV" exifData checkPrettyPrinter meteringMode "Pattern" exifData checkPrettyPrinter lightSource "Unknown" exifData @@ -154,8 +159,12 @@ checkPrettyPrinter resolutionUnit "Inch" exifData checkPrettyPrinter yCbCrPositioning "Co-sited" exifData checkPrettyPrinter gpsLatitude "50.217917" 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 -> String -> Map ExifTag ExifValue -> Assertion +checkPrettyPrinter :: ExifTag -> Text -> Map ExifTag ExifValue -> Assertion checkPrettyPrinter tag str exifData = assertEqual' (Just str) $ liftM (prettyPrinter tag) $ Map.lookup tag exifData testFlashFired :: Map ExifTag ExifValue -> Spec @@ -186,6 +195,16 @@ makeExifMapWithFlash :: Int -> Map ExifTag ExifValue makeExifMapWithFlash flashV = Map.fromList [(flash, ExifNumber flashV)] + +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 assertEqual' :: (Show a, Eq a) => a -> a -> Assertion assertEqual' = assertEqual "doesn't match"