hsexif 0.5.0.3 → 0.6.0.0
raw patch · 7 files changed
+277/−175 lines, 7 filesdep +iconvdep +textPVP ok
version bump matches the API change (PVP)
Dependencies added: iconv, text
API changes (from Hackage documentation)
+ Graphics.HsExif: getGpsDateTime :: Map ExifTag ExifValue -> Maybe LocalTime
+ Graphics.HsExif: parseGpsTime :: ExifValue -> Maybe TimeOfDay
- Graphics.HsExif: ExifTag :: TagLocation -> Maybe String -> Word16 -> (ExifValue -> String) -> ExifTag
+ Graphics.HsExif: ExifTag :: TagLocation -> Maybe String -> Word16 -> (ExifValue -> Text) -> ExifTag
- Graphics.HsExif: prettyPrinter :: ExifTag -> ExifValue -> String
+ Graphics.HsExif: prettyPrinter :: ExifTag -> ExifValue -> Text
Files
- Graphics/ExifTags.hs +126/−84
- Graphics/Helpers.hs +37/−0
- Graphics/HsExif.hs +7/−32
- Graphics/PrettyPrinters.hs +59/−35
- Graphics/Types.hs +2/−1
- hsexif.cabal +8/−4
- tests/Tests.hs +38/−19
Graphics/ExifTags.hs view
@@ -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
+ Graphics/Helpers.hs view
@@ -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
Graphics/HsExif.hs view
@@ -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
Graphics/PrettyPrinters.hs view
@@ -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
Graphics/Types.hs view
@@ -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.
hsexif.cabal view
@@ -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
tests/Tests.hs view
@@ -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"