diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -13,7 +13,7 @@ getOrientation, ImageOrientation(..), RotationDirection(..), - readGpsLatitudeLongitude, + getGpsLatitudeLongitude, -- * The ExifValue type ExifValue(..), @@ -142,7 +142,7 @@ import Data.Binary.Put import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as BS -import Control.Monad (liftM, unless) +import Control.Monad (liftM, unless, replicateM) import qualified Data.ByteString.Char8 as Char8 import Data.Word import Data.Char (isDigit, ord, chr) @@ -239,7 +239,7 @@ getWord32 Intel = getWord32le getWord32 Motorola = getWord32be -putWord32 :: ByteAlign -> (Word32 -> Put) +putWord32 :: ByteAlign -> Word32 -> Put putWord32 Intel = putWord32le putWord32 Motorola = putWord32be @@ -514,16 +514,16 @@ readMany :: ByteAlign -> Int -> Get ExifValue } -readNumberList decoder = \byteAlign components -> liftM (ExifNumberList . fmap fromIntegral) - $ readManyInternal byteAlign components - where readManyInternal byteAlign components = count components (decoder byteAlign) +readNumberList :: Integral a => (ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue +readNumberList decoder byteAlign components = liftM (ExifNumberList . fmap fromIntegral) + $ count components (decoder byteAlign) unsignedByteValueHandler = ValueHandler { dataTypeId = 1, dataLength = 1, readSingle = \_ -> liftM (ExifNumber . fromIntegral) getWord8, - readMany = readNumberList (\_ -> getWord8) + readMany = readNumberList $ const getWord8 } asciiStringValueHandler = ValueHandler @@ -538,7 +538,7 @@ { dataTypeId = 3, dataLength = 2, - readSingle = \byteAlign -> liftM (ExifNumber . fromIntegral) $ getWord16 byteAlign, + readSingle = liftM (ExifNumber . fromIntegral) . getWord16, readMany = readNumberList getWord16 } @@ -546,7 +546,7 @@ { dataTypeId = 4, dataLength = 4, - readSingle = \byteAlign -> liftM (ExifNumber . fromIntegral) $ getWord32 byteAlign, + readSingle = liftM (ExifNumber . fromIntegral) . getWord32, readMany = readNumberList getWord32 } @@ -561,8 +561,7 @@ dataTypeId = 5, dataLength = 8, readSingle = readRationalContents ExifRational, - readMany = let readManyInternal byteAlign components = count components (readRationalContents (,) byteAlign) in - \byteAlign components -> liftM ExifRationalList $ readManyInternal byteAlign components + readMany = \byteAlign components -> liftM ExifRationalList $ count components (readRationalContents (,) byteAlign) } signedByteValueHandler = ValueHandler @@ -570,7 +569,7 @@ dataTypeId = 6, dataLength = 1, readSingle = \_ -> liftM (ExifNumber . signedInt8ToInt) getWord8, - readMany = readNumberList (\_ -> liftM signedInt8ToInt getWord8) + readMany = readNumberList (liftM signedInt8ToInt . const getWord8) } undefinedValueHandler = ValueHandler @@ -585,16 +584,16 @@ { dataTypeId = 8, dataLength = 2, - readSingle = \byteAlign -> liftM (ExifNumber . signedInt16ToInt) $ getWord16 byteAlign, - readMany = readNumberList (\b -> liftM signedInt16ToInt $ getWord16 b) + readSingle = liftM (ExifNumber . signedInt16ToInt) . getWord16, + readMany = readNumberList (liftM signedInt16ToInt . getWord16) } signedLongValueHandler = ValueHandler { dataTypeId = 9, dataLength = 4, - readSingle = \byteAlign -> liftM (ExifNumber . signedInt32ToInt) $ getWord32 byteAlign, - readMany = readNumberList (\b -> liftM signedInt32ToInt $ getWord32 b) + readSingle = liftM (ExifNumber . signedInt32ToInt) . getWord32, + readMany = readNumberList (liftM signedInt32ToInt . getWord32) } readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a @@ -608,8 +607,7 @@ dataTypeId = 10, dataLength = 8, readSingle = readSignedRationalContents ExifRational, - readMany = let readManyInternal byteAlign components = count components (readSignedRationalContents (,) byteAlign) in - \byteAlign components -> liftM ExifRationalList $ readManyInternal byteAlign components + readMany = \byteAlign components -> liftM ExifRationalList $ count components (readSignedRationalContents (,) byteAlign) } valueHandlers :: [ValueHandler] @@ -643,12 +641,12 @@ getHandler typeId = find ((==typeId) . dataTypeId) valueHandlers decodeEntryWithHandler :: ByteAlign -> Int -> ValueHandler -> IfEntry -> Get ExifValue -decodeEntryWithHandler byteAlign tiffHeaderStart handler entry = do - if dataLength handler * (entryNoComponents entry) <= 4 - then return $ parseInline byteAlign handler entry inlineBs +decodeEntryWithHandler byteAlign tiffHeaderStart handler entry = + if dataLength handler * entryNoComponents entry <= 4 + then do + let inlineBs = runPut $ putWord32 byteAlign $ entryContents entry + return $ parseInline byteAlign handler entry inlineBs else parseOffset byteAlign tiffHeaderStart handler entry - where - inlineBs = runPut $ putWord32 byteAlign $ entryContents entry parseInline :: ByteAlign -> ValueHandler -> IfEntry -> B.ByteString -> ExifValue parseInline byteAlign handler entry bytestring = @@ -702,7 +700,7 @@ count :: Int -> Get a -> Get [a] count n p | n <= 0 = return [] - | otherwise = sequence (replicate n p) + | otherwise = replicateM n p -- | Extract the date and time when the picture was taken @@ -752,26 +750,27 @@ -- | Extract the GPS latitude and longitude where the picture was taken -- (if it is present in the EXIF) -readGpsLatitudeLongitude :: Map ExifTag ExifValue -> Maybe (Double, Double) -readGpsLatitudeLongitude exifData = do +getGpsLatitudeLongitude :: Map ExifTag ExifValue -> Maybe (Double, Double) +getGpsLatitudeLongitude exifData = do (ExifText latRef) <- Map.lookup gpsLatitudeRef exifData - latDec <- liftM gpsDecodeToDecimalDegrees $ Map.lookup gpsLatitude exifData + latDec <- Map.lookup gpsLatitude exifData >>= gpsDecodeToDecimalDegrees let signedLatDec = case latRef of "S" -> -latDec _ -> latDec (ExifText longRef) <- Map.lookup gpsLongitudeRef exifData - longDec <- liftM gpsDecodeToDecimalDegrees $ Map.lookup gpsLongitude exifData + longDec <- Map.lookup gpsLongitude exifData >>= gpsDecodeToDecimalDegrees let signedLongDec = case longRef of "W" -> -longDec _ -> longDec return (signedLatDec, signedLongDec) -gpsDecodeToDecimalDegrees :: ExifValue -> Double -gpsDecodeToDecimalDegrees (ExifRationalList intPairs) = floatings !! 0 + floatings !! 1 / 60 + floatings !! 2 / 3600 +gpsDecodeToDecimalDegrees :: ExifValue -> Maybe Double +gpsDecodeToDecimalDegrees (ExifRationalList intPairs) = case fmap (uncurry intsToFloating) intPairs of + (degrees:minutes:seconds:[]) -> Just $ degrees + minutes / 60 + seconds / 3600 + _ -> Nothing where - floatings = fmap (uncurry intsToFloating) intPairs - intsToFloating n d = (fromIntegral n) / (fromIntegral d) -gpsDecodeToDecimalDegrees _ = error "gpsDecodeToDecimalDegrees not called on a rational list!?" -- no way to prevent this at compile time??? + intsToFloating n d = fromIntegral n / fromIntegral d +gpsDecodeToDecimalDegrees _ = Nothing -- $intro -- 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.4.0.1 +version: 0.5.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. diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -26,8 +26,9 @@ describe "basic parsing" $ testBasic imageContents describe "extract picture date" $ testDate exifData describe "image orientation" $ testOrientation exifData - describe "read exif date time" $ testReadExifDateTime + describe "read exif date time" testReadExifDateTime describe "read GPS lat long" $ testReadGpsLatLong gpsExifData + describe "read GPS lat long -- no data" $ testReadGpsLatLongNoData exifData testNotAJpeg :: B.ByteString -> Spec testNotAJpeg imageContents = it "returns empty list if not a JPEG" $ @@ -94,7 +95,7 @@ where -- the makerNote is HUGE. so test it separately. parsed = (\(Right x) -> x) $ parseExif imageContents - cleanedParsed = Map.fromList $ filter (\(a,_) -> not (a==makerNote)) $ Map.toList parsed + cleanedParsed = Map.fromList $ filter (\(a,_) -> (a/=makerNote)) $ Map.toList parsed makerNoteV = (\(Just (ExifUndefined x)) -> x) $ Map.lookup makerNote parsed testDate :: Map ExifTag ExifValue -> Spec @@ -113,9 +114,13 @@ testReadGpsLatLong :: Map ExifTag ExifValue -> Spec testReadGpsLatLong exifData = it "reads gps latitude longitude" $ do - let (Just (lat,long)) = readGpsLatitudeLongitude exifData + let (Just (lat,long)) = getGpsLatitudeLongitude exifData assertBool' $ 50.2179 < lat && 50.2180 > lat assertBool' $ -5.031 > long && -5.032 < long + +testReadGpsLatLongNoData :: Map ExifTag ExifValue -> Spec +testReadGpsLatLongNoData exifData = it "reads gps latitude longitude" $ + assertEqual' Nothing $ getGpsLatitudeLongitude exifData assertEqual' :: (Show a, Eq a) => a -> a -> Assertion assertEqual' = assertEqual "doesn't match"