hsexif 0.6.0.0 → 0.6.0.1
raw patch · 6 files changed
+114/−80 lines, 6 filesdep ~hspecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec
API changes (from Hackage documentation)
Files
- Graphics/ExifTags.hs +30/−10
- Graphics/Helpers.hs +17/−12
- Graphics/HsExif.hs +46/−53
- Graphics/PrettyPrinters.hs +7/−0
- hsexif.cabal +2/−2
- tests/Tests.hs +12/−3
Graphics/ExifTags.hs view
@@ -11,6 +11,7 @@ import Data.Time.Calendar import Data.Time.LocalTime import Data.Binary.Get+import Data.Maybe (fromMaybe) import Graphics.Types import Graphics.PrettyPrinters@@ -47,7 +48,7 @@ compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (T.pack . formatAsFloatingPoint 2) shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ withFormat "%s sec." apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppAperture-brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 showT+brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 $ asFpWithFormat "%s EV" exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 $ asFpWithFormat "%s EV" maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 ppAperture subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 showT@@ -74,7 +75,7 @@ subjectLocation = exifSubIfdTag "subjectLocation" 0xa214 showT exposureIndex = exifSubIfdTag "exposureIndex" 0xa215 showT sensingMethod = exifSubIfdTag "sensingMethod" 0xa217 ppSensingMethod-fileSource = exifSubIfdTag "fileSource" 0xa300 showT+fileSource = exifSubIfdTag "fileSource" 0xa300 ppFileSource sceneType = exifSubIfdTag "sceneType" 0xa301 ppSceneType cfaPattern = exifSubIfdTag "cfaPattern" 0xa302 showT customRendered = exifSubIfdTag "customRendered" 0xa401 ppCustomRendered@@ -113,9 +114,9 @@ printImageMatching = exifIfd0Tag "printImageMatching" 0xc4a5 ppUndef gpsVersionID = exifGpsTag "gpsVersionID" 0x0000 showT-gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 showT+gpsLatitudeRef = exifGpsTag "gpsLatitudeRef" 0x0001 ppGpsLatitudeRef gpsLatitude = exifGpsTag "gpsLatitude" 0x0002 ppGpsLongLat-gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 showT+gpsLongitudeRef = exifGpsTag "gpsLongitudeRef" 0x0003 ppGpsLongitudeRef gpsLongitude = exifGpsTag "gpsLongitude" 0x0004 ppGpsLongLat gpsAltitudeRef = exifGpsTag "gpsAltitudeRef" 0x0005 ppGpsAltitudeRef gpsAltitude = exifGpsTag "gpsAltitude" 0x0006 (T.pack . formatAsFloatingPoint 4)@@ -187,18 +188,27 @@ _ -> longDec return (signedLatDec, signedLongDec) -gpsDecodeToDecimalDegrees :: ExifValue -> Maybe Double-gpsDecodeToDecimalDegrees (ExifRationalList intPairs) = case fmap intPairToFloating intPairs of- (degrees:minutes:seconds:[]) -> Just $ degrees + minutes / 60 + seconds / 3600+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-gpsDecodeToDecimalDegrees _ = Nothing+gpsLongLatToCoords _ = Nothing +gpsDecodeToDecimalDegrees :: ExifValue -> Maybe Double+gpsDecodeToDecimalDegrees v = do+ (degrees, minutes, seconds) <- gpsLongLatToCoords v+ return $ degrees + minutes / 60 + seconds / 3600+ ppGpsLongLat :: ExifValue -> Text-ppGpsLongLat v = maybe "invalid GPS data" fmt $ gpsDecodeToDecimalDegrees v- where fmt = T.pack . printf "%.6f"+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+ -- | Extract the GPS date time, if present in the picture. getGpsDateTime :: Map ExifTag ExifValue -> Maybe LocalTime getGpsDateTime exifData = do@@ -230,3 +240,13 @@ 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++ppGpsLatitudeRef :: ExifValue -> Text+ppGpsLatitudeRef (ExifText "N") = "North"+ppGpsLatitudeRef (ExifText "S") = "South"+ppGpsLatitudeRef v@_ = T.pack $ "Invalid latitude: " ++ show v++ppGpsLongitudeRef :: ExifValue -> Text+ppGpsLongitudeRef (ExifText "E") = "East"+ppGpsLongitudeRef (ExifText "W") = "West"+ppGpsLongitudeRef v@_ = T.pack $ "Invalid longitude: " ++ show v
Graphics/Helpers.hs view
@@ -2,20 +2,26 @@ import Data.Binary.Get import qualified Data.ByteString.Lazy as B-import Control.Monad (liftM, replicateM)+import Control.Monad (replicateM)+import Control.Applicative ( (<$>) ) 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.+-- | Suppress the 'Left' value of an 'Either'+-- From the 'errors' package.+hush :: Either a b -> Maybe b+hush = either (const Nothing) Just++runEitherGet :: Get a -> B.ByteString -> Either String a+runEitherGet get bs = case runGetOrFail get bs of+ Left (_,_,errorMsg) -> Left errorMsg+ Right (_,_,x) -> Right x+ runMaybeGet :: Get a -> B.ByteString -> Maybe a-runMaybeGet get bs = case runGetOrFail get bs of- Left _ -> Nothing- Right (_,_,x) -> Just x+runMaybeGet get = hush . runEitherGet get getCharWhere :: (Char->Bool) -> Get Char getCharWhere wher = do- char <- liftM (chr . fromIntegral) getWord8+ char <- chr . fromIntegral <$> getWord8 if wher char then return char else fail "no parse"@@ -27,11 +33,10 @@ getCharValue char = getCharWhere (==char) readDigit :: Read a => Int -> Get a-readDigit x = liftM read $ count x getDigit+readDigit x = read <$> count x getDigit count :: Int -> Get a -> Get [a]-count n p | n <= 0 = return []- | otherwise = replicateM n p+count = replicateM stringToByteString :: String -> B.ByteString-stringToByteString str = B.pack $ map (fromIntegral . ord) str+stringToByteString = B.pack . map (fromIntegral . ord)
Graphics/HsExif.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -- | Ability to work with the EXIF data contained in JPEG files. module Graphics.HsExif (@@ -146,6 +147,7 @@ import Data.Binary.Put import qualified Data.ByteString.Lazy as B import Control.Monad (liftM, unless)+import Control.Applicative ( (<$>) ) import qualified Data.ByteString.Char8 as Char8 import Data.Word import Data.Char (ord)@@ -169,13 +171,11 @@ -- | Read EXIF data from the file you give. It's a key-value map. parseFileExif :: FilePath -> IO (Either String (Map ExifTag ExifValue))-parseFileExif filename = liftM parseExif $ B.readFile filename+parseFileExif filename = parseExif <$> B.readFile filename -- | Read EXIF data from a lazy bytestring. parseExif :: B.ByteString -> Either String (Map ExifTag ExifValue)-parseExif contents = case runGetOrFail getExif contents of- Left (_,_,errorMsg) -> Left errorMsg- Right (_,_,result) -> Right result+parseExif = runEitherGet getExif getExif :: Get (Map ExifTag ExifValue) getExif = do@@ -187,7 +187,7 @@ findAndParseExifBlock :: Get (Map ExifTag ExifValue) findAndParseExifBlock = do markerNumber <- getWord16be- dataSize <- liftM (fromIntegral . toInteger) getWord16be+ dataSize <- fromIntegral . toInteger <$> getWord16be case markerNumber of 0xffe1 -> parseExifBlock -- ffda is Start Of Stream => image@@ -212,59 +212,53 @@ parseExifBlock :: Get (Map ExifTag ExifValue) parseExifBlock = do header <- getByteString 4- nul <- liftM toInteger getWord16be+ nul <- toInteger <$> getWord16be unless (header == Char8.pack "Exif" && nul == 0) $ fail "invalid EXIF header"- tiffHeaderStart <- liftM fromIntegral bytesRead+ tiffHeaderStart <- fromIntegral <$> bytesRead byteAlign <- parseTiffHeader- (exifSubIfdOffsetW, mGpsOffsetW, ifdEntries) <- parseIfd byteAlign tiffHeaderStart- let exifSubIfdOffset = fromIntegral $ toInteger exifSubIfdOffsetW- gpsData <- case mGpsOffsetW of- Nothing -> return []- Just gpsOffsetW -> lookAhead $ parseGps gpsOffsetW byteAlign tiffHeaderStart- -- skip to the exif offset- bytesReadNow <- liftM fromIntegral bytesRead- skip $ (exifSubIfdOffset + tiffHeaderStart) - bytesReadNow- exifSubEntries <- parseSubIfd byteAlign tiffHeaderStart ExifSubIFD+ 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 -parseGps :: Word32 -> ByteAlign -> Int -> Get [(ExifTag, ExifValue)]-parseGps gpsOffsetW byteAlign tiffHeaderStart = do- let gpsOffset = fromIntegral $ toInteger gpsOffsetW- bytesReadNow <- liftM fromIntegral bytesRead- skip $ (gpsOffset + tiffHeaderStart) - bytesReadNow- parseSubIfd byteAlign tiffHeaderStart GpsSubIFD+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 parseTiffHeader :: Get ByteAlign parseTiffHeader = do- byteAlignV <- getByteString 2- let byteAlign = case Char8.unpack byteAlignV of- "II" -> Intel- "MM" -> Motorola- _ -> error "Unknown byte alignment"- alignControl <- liftM toInteger (getWord16 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 <- liftM (fromIntegral . toInteger) (getWord32 byteAlign)+ ifdOffset <- fromIntegral . toInteger <$> getWord32 byteAlign skip $ ifdOffset - 8 return byteAlign -parseIfd :: ByteAlign -> Int -> Get (Word32, Maybe Word32, [(ExifTag, ExifValue)])+parseIfd :: ByteAlign -> Int -> Get (Maybe Word32, Maybe Word32, [(ExifTag, ExifValue)]) parseIfd byteAlign tiffHeaderStart = do- dirEntriesCount <- liftM toInteger (getWord16 byteAlign)+ dirEntriesCount <- toInteger <$> getWord16 byteAlign ifdEntries <- mapM (\_ -> parseIfEntry byteAlign) [1..dirEntriesCount]- let exifOffsetEntry = fromMaybe (error "Can't find the exif ifd offset")- (find (\ e -> entryTag e == tagKey exifIfdOffset) ifdEntries)- let exifOffset = entryContents exifOffsetEntry-- let gpsOffsetEntry = find (\ e -> entryTag e == tagKey gpsTagOffset) ifdEntries- let gpsOffset = fmap entryContents gpsOffsetEntry+ 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 <- liftM toInteger (getWord16 byteAlign)+ dirEntriesCount <- toInteger <$> getWord16 byteAlign ifdEntries <- mapM (\_ -> parseIfEntry byteAlign) [1..dirEntriesCount] mapM (decodeEntry byteAlign tiffHeaderStart location) ifdEntries @@ -303,14 +297,14 @@ } readNumberList :: Integral a => (ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue-readNumberList decoder byteAlign components = liftM (ExifNumberList . fmap fromIntegral)- $ count components (decoder byteAlign)+readNumberList decoder byteAlign components = ExifNumberList . fmap fromIntegral <$>+ count components (decoder byteAlign) unsignedByteValueHandler = ValueHandler { dataTypeId = 1, dataLength = 1,- readSingle = \_ -> liftM (ExifNumber . fromIntegral) getWord8,+ readSingle = \_ -> ExifNumber . fromIntegral <$> getWord8, readMany = readNumberList $ const getWord8 } @@ -319,7 +313,7 @@ dataTypeId = 2, dataLength = 1, readSingle = \ba -> readMany asciiStringValueHandler ba 1,- readMany = \_ components -> liftM (ExifText . Char8.unpack) (getByteString (components-1))+ readMany = \_ components -> ExifText . Char8.unpack <$> getByteString (components-1) } unsignedShortValueHandler = ValueHandler@@ -340,8 +334,8 @@ readRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a readRationalContents c byteAlign = do- numerator <- liftM fromIntegral $ getWord32 byteAlign- denominator <- liftM fromIntegral $ getWord32 byteAlign+ numerator <- fromIntegral <$> getWord32 byteAlign+ denominator <- fromIntegral <$> getWord32 byteAlign return $ c numerator denominator unsignedRationalValueHandler = ValueHandler@@ -349,14 +343,14 @@ dataTypeId = 5, dataLength = 8, readSingle = readRationalContents ExifRational,- readMany = \byteAlign components -> liftM ExifRationalList $ count components (readRationalContents (,) byteAlign)+ readMany = \byteAlign components -> ExifRationalList <$> count components (readRationalContents (,) byteAlign) } signedByteValueHandler = ValueHandler { dataTypeId = 6, dataLength = 1,- readSingle = \_ -> liftM (ExifNumber . signedInt8ToInt) getWord8,+ readSingle = \_ -> ExifNumber . signedInt8ToInt <$> getWord8, readMany = readNumberList (liftM signedInt8ToInt . const getWord8) } @@ -365,7 +359,7 @@ dataTypeId = 7, dataLength = 1, readSingle = \ba -> readMany undefinedValueHandler ba 1,- readMany = \_ components -> liftM ExifUndefined (getByteString components)+ readMany = \_ components -> ExifUndefined <$> getByteString components } signedShortValueHandler = ValueHandler@@ -386,8 +380,8 @@ readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a readSignedRationalContents c byteAlign = do- numerator <- liftM signedInt32ToInt $ getWord32 byteAlign- denominator <- liftM signedInt32ToInt $ getWord32 byteAlign+ numerator <- signedInt32ToInt <$> getWord32 byteAlign+ denominator <- signedInt32ToInt <$> getWord32 byteAlign return $ c numerator denominator signedRationalValueHandler = ValueHandler@@ -395,7 +389,7 @@ dataTypeId = 10, dataLength = 8, readSingle = readSignedRationalContents ExifRational,- readMany = \byteAlign components -> liftM ExifRationalList $ count components (readSignedRationalContents (,) byteAlign)+ readMany = \byteAlign components -> ExifRationalList <$> count components (readSignedRationalContents (,) byteAlign) } valueHandlers :: [ValueHandler]@@ -447,7 +441,7 @@ parseOffset :: ByteAlign -> Int -> ValueHandler -> IfEntry -> Get ExifValue parseOffset byteAlign tiffHeaderStart handler entry = do let contentsInt = fromIntegral $ toInteger $ entryContents entry- curPos <- liftM fromIntegral bytesRead+ curPos <- fromIntegral <$> bytesRead skip $ contentsInt + tiffHeaderStart - curPos bytestring <- getLazyByteString (fromIntegral $ entryNoComponents entry * dataLength handler) return $ parseInline byteAlign handler entry bytestring@@ -517,8 +511,7 @@ -- the information. wasFlashFired :: Map ExifTag ExifValue -> Maybe Bool wasFlashFired exifData = do- flashVal <- Map.lookup flash exifData- case flashVal of+ Map.lookup flash exifData >>= \case ExifNumber n -> Just $ n .&. 1 /= 0 _ -> Nothing
Graphics/PrettyPrinters.hs view
@@ -207,6 +207,13 @@ rawText = BL.fromStrict $ BS.drop 8 v ppUserComment v@_ = unknown v +-- | Pretty printer for the FileSource tag+ppFileSource :: ExifValue -> Text+ppFileSource (ExifUndefined v)+ | BS.head v == 3 = "DSC"+ | otherwise = "(unknown)"+ppFileSource v = unknown v+ getIconvEncodingName :: Text -> EncodingName getIconvEncodingName "JIS" = "SJIS" getIconvEncodingName x@_ = T.unpack x -- ASCII and UNICODE work out of the box.
hsexif.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hsexif-version: 0.6.0.0+version: 0.6.0.1 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.@@ -38,7 +38,7 @@ main-is: Tests.hs default-language: Haskell2010 build-depends: base,- hspec == 1.10.*,+ hspec >= 1.8 && < 1.11, HUnit >= 1.2 && <1.3, binary >=0.7 && <0.8, bytestring >=0.10 && <0.11,
tests/Tests.hs view
@@ -10,7 +10,7 @@ import Data.Time.LocalTime import Data.Time.Calendar import Data.Char (chr)-import Control.Monad (liftM)+import Control.Applicative ( (<$>) ) import Data.List import Graphics.HsExif@@ -22,6 +22,7 @@ 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@@ -38,6 +39,7 @@ 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" $@@ -158,14 +160,15 @@ checkPrettyPrinter saturation "Normal" exifData checkPrettyPrinter resolutionUnit "Inch" exifData checkPrettyPrinter yCbCrPositioning "Co-sited" exifData- checkPrettyPrinter gpsLatitude "50.217917" 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) $ liftM (prettyPrinter tag) $ Map.lookup tag exifData+checkPrettyPrinter tag str exifData = assertEqual' (Just str) $ prettyPrinter tag <$> Map.lookup tag exifData testFlashFired :: Map ExifTag ExifValue -> Spec testFlashFired exifData = it "properly reads whether the flash was fired" $ do@@ -195,6 +198,12 @@ 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 assertEqualListDebug :: (Show a, Eq a) => [a] -> [a] -> Assertion assertEqualListDebug = assertEqualListDebug' (0 :: Int)