diff --git a/Graphics/ExifTags.hs b/Graphics/ExifTags.hs --- a/Graphics/ExifTags.hs +++ b/Graphics/ExifTags.hs @@ -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 diff --git a/Graphics/Helpers.hs b/Graphics/Helpers.hs --- a/Graphics/Helpers.hs +++ b/Graphics/Helpers.hs @@ -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) diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -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 diff --git a/Graphics/PrettyPrinters.hs b/Graphics/PrettyPrinters.hs --- a/Graphics/PrettyPrinters.hs +++ b/Graphics/PrettyPrinters.hs @@ -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. 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.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, diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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)