packages feed

hsexif (empty) → 0.1.0.0

raw patch · 5 files changed

+354/−0 lines, 5 filesdep +HUnitdep +basedep +binarysetup-changed

Dependencies added: HUnit, base, binary, bytestring, containers, hspec, time

Files

+ Graphics/HsExif.hs view
@@ -0,0 +1,244 @@+-- | Ability to work with the EXIF data contained in JPEG files.+module Graphics.HsExif (ExifTag(..), parseFileExif, parseExif, getDateTimeOriginal) where++import Data.Binary.Get+import qualified Data.ByteString.Lazy as B+import Control.Monad (liftM, unless, when)+import qualified Data.ByteString.Char8 as Char8+import Data.Word+import Data.Int+import Data.List+import Data.Maybe (fromMaybe)+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Time.LocalTime+import Data.Time.Calendar++-- see http://www.media.mit.edu/pia/Research/deepview/exif.html++-- | Read EXIF data from the file you give. It's a key-value map.+parseFileExif :: FilePath -> IO (Either String (Map ExifTag String))+parseFileExif filename = liftM parseExif $ B.readFile filename++-- | Read EXIF data from a lazy bytestring.+parseExif :: B.ByteString -> Either String (Map ExifTag String)+parseExif contents = case runGetOrFail getExif contents of+		Left (bs,offset,errorMsg) -> Left errorMsg+		Right (bs,offset,result) -> Right result++getExif :: Get (Map ExifTag String)+getExif = do+	header <- getWord16be+	unless (header == 0xffd8)+		$ fail "Not a JPEG file"+	findAndParseExifBlock++findAndParseExifBlock :: Get (Map ExifTag String)+findAndParseExifBlock = do+	markerNumber <- getWord16be+	dataSize <- liftM (fromIntegral . toInteger) getWord16be+	case markerNumber of+		0xffe1 -> parseExifBlock dataSize+		-- ffda is Start Of Stream => image+		-- I expect no more EXIF data after this point.+		0xffda -> fail "No EXIF in JPEG" +		_ -> skip (dataSize-2) >> findAndParseExifBlock++data ByteAlign = Intel | Motorola++getWord16 :: ByteAlign -> Get Word16+getWord16 Intel = getWord16le+getWord16 Motorola = getWord16be++getWord32 :: ByteAlign -> Get Word32+getWord32 Intel = getWord32le+getWord32 Motorola = getWord32be++parseExifBlock :: Int -> Get (Map ExifTag String)+parseExifBlock blockLength = do+	header <- getByteString 4+	null <- liftM toInteger getWord16be+	unless (header == Char8.pack "Exif" && null == 0)+		$ fail "invalid EXIF header"+	tiffHeaderStart <- liftM fromIntegral bytesRead+	byteAlign <- parseTiffHeader+	exifSubIfdOffset <- liftM (fromIntegral . toInteger) (parseIfd byteAlign tiffHeaderStart)+	-- skip to the exif offset+	bytesReadNow <- liftM fromIntegral bytesRead+	skip $ (exifSubIfdOffset + tiffHeaderStart) - bytesReadNow+	parseExifSubIfd byteAlign tiffHeaderStart++parseTiffHeader :: Get ByteAlign+parseTiffHeader = do+	byteAlignV <- getByteString 2+	let byteAlign = case Char8.unpack byteAlignV of+		"II" -> Intel+		"MM" -> Motorola+	alignControl <- liftM toInteger (getWord16 byteAlign)+	unless (alignControl == 0x2a)+		$ fail "exif byte alignment mismatch"+	ifdOffset <- liftM (fromIntegral . toInteger) (getWord32 byteAlign)+	skip $ ifdOffset - 8+	return byteAlign++parseIfd :: ByteAlign -> Int -> Get Word32+parseIfd byteAlign tiffHeaderStart = do+	dirEntriesCount <- liftM toInteger (getWord16 byteAlign)+	ifdEntries <- mapM (\_ -> parseIfEntry byteAlign tiffHeaderStart) [1..dirEntriesCount]+	let exifOffsetEntry = fromMaybe (error "Can't find the exif offset in the IFD")+		(find (\ e -> entryTag e == 0x8769) ifdEntries)+	let exifOffset = entryContents exifOffsetEntry+	return exifOffset++parseExifSubIfd :: ByteAlign -> Int -> Get (Map ExifTag String)+parseExifSubIfd byteAlign tiffHeaderStart = do+	dirEntriesCount <- liftM toInteger (getWord16 byteAlign)+	ifdEntries <- mapM (\_ -> parseIfEntry byteAlign tiffHeaderStart) [1..dirEntriesCount]+	list <- mapM (decodeEntry byteAlign tiffHeaderStart) ifdEntries+	return $ Map.fromList list++data IfEntry = IfEntry+	{+		entryTag :: !Word16,+		entryFormat :: !Word16,+		entryNoComponents :: !Word32,+		entryContents :: !Word32+	} deriving Show++parseIfEntry :: ByteAlign -> Int -> Get IfEntry+parseIfEntry byteAlign tiffHeaderStart = do+	tagNumber <- getWord16 byteAlign+	dataFormat <- getWord16 byteAlign+	numComponents <- getWord32 byteAlign+	value <- getWord32 byteAlign+	return IfEntry+		{+			entryTag = tagNumber,+			entryFormat = dataFormat,+			entryNoComponents = numComponents,+			entryContents = value+		}++data ExifTag = ExposureTime+	| FNumber+	| ExposureProgram+	| ISOSpeedRatings+	| ExifVersion+	| DateTimeOriginal+	| DateTimeDigitized+	| ComponentConfiguration+	| CompressedBitsPerPixel+	| ShutterSpeedValue+	| ApertureValue+	| BrightnessValue+	| ExposureBiasValue+	| MaxApertureValue+	| SubjectDistance+	| MeteringMode+	| LightSource+	| Flash+	| FocalLength+	| MakerNote+	| UserComment+	| FlashPixVersion+	| ColorSpace+	| ExifImageWidth+	| ExifImageHeight+	| RelatedSoundFile+	| ExifInteroperabilityOffset+	| FocalPlaneXResolution+	| FocalPlaneYResolution+	| FocalPlaneResolutionUnit+	| SensingMethod+	| FileSource+	| SceneType+	| Unknown Word16+	deriving (Eq, Ord, Show)++getExifTag :: Word16 -> ExifTag+getExifTag entryTag = case entryTag of+	0x829a -> ExposureTime+	0x829d -> FNumber+	0x8822 -> ExposureProgram+	0x8827 -> ISOSpeedRatings+	0x9000 -> ExifVersion+	0x9003 -> DateTimeOriginal+	0x9004 -> DateTimeDigitized+	0x9101 -> ComponentConfiguration+	0x9102 -> CompressedBitsPerPixel+	0x9201 -> ShutterSpeedValue+	0x9202 -> ApertureValue+	0x9203 -> BrightnessValue+	0x9204 -> ExposureBiasValue+	0x9205 -> MaxApertureValue+	0x9206 -> SubjectDistance+	0x9207 -> MeteringMode+	0x9208 -> LightSource+	0x9209 -> Flash+	0x920a -> FocalLength+	0x927c -> MakerNote+	0x9286 -> UserComment+	0xa000 -> FlashPixVersion+	0xa001 -> ColorSpace+	0xa002 -> ExifImageWidth+	0xa003 -> ExifImageHeight+	0xa004 -> RelatedSoundFile+	0xa005 -> ExifInteroperabilityOffset+	0xa20e -> FocalPlaneXResolution+	0xa20f -> FocalPlaneYResolution+	0xa210 -> FocalPlaneResolutionUnit+	0xa217 -> SensingMethod+	0xa300 -> FileSource+	0xa301 -> SceneType+	_ -> Unknown entryTag++decodeEntry :: ByteAlign -> Int -> IfEntry -> Get (ExifTag, String)+decodeEntry byteAlign tiffHeaderStart entry = do+	let tagKey = getExifTag $ entryTag entry+	let contentsInt = fromIntegral $ toInteger $ entryContents entry+	let componentsInt = fromIntegral $ toInteger $ entryNoComponents entry+	-- because I only know how to skip ahead, I hope the entries+	-- are always sorted in order of the offsets to their values...+	-- (maybe lookAhead could help here?)+	tagValue <- case entryFormat entry of+		1 -> return $ show contentsInt -- unsigned byte+		2 -> do -- ascii string+			curPos <- liftM fromIntegral bytesRead+			skip $ contentsInt + tiffHeaderStart - curPos+			liftM Char8.unpack (getByteString (componentsInt-1))+		3 -> return $ show contentsInt -- unsigned short+		4 -> return $ show contentsInt -- unsigned long+		5 -> do -- unsigned rational+			curPos <- liftM fromIntegral bytesRead+			skip $ contentsInt + tiffHeaderStart - curPos+			numerator <- getWord32 byteAlign+			denominator <- getWord32 byteAlign+			return $ show numerator ++ "/" ++ show denominator+		6 -> return $ show $ word32toint32 $ entryContents entry -- signed byte+		7 -> return $ show contentsInt -- undefined+		8 -> return $ show $ word32toint32 $ entryContents entry -- signed short+		9 -> return $ show $ word32toint32 $ entryContents entry -- signed long+		10 -> do -- signed rational+			curPos <- liftM fromIntegral bytesRead+			skip $ contentsInt + tiffHeaderStart - curPos+			numerator <- liftM word32toint32 (getWord32 byteAlign)+			denominator <- liftM word32toint32 (getWord32 byteAlign)+			return $ show numerator ++ "/" ++ show denominator+		-- TODO decode float values, 11 single float and 12 double float but I'd like tests+		_ -> return $ "type: " ++ show (entryFormat entry) ++ " -> " ++ show contentsInt+	return (tagKey, tagValue)++word32toint32 :: Word32 -> Int32+word32toint32 word = fromIntegral word :: Int32++-- | Extract the date and time when the picture was taken+-- from the EXIF information.+getDateTimeOriginal :: Map ExifTag String -> Maybe LocalTime+getDateTimeOriginal exifData = do +	dateStr <- Map.lookup DateTimeOriginal exifData+	-- i know more elegant ways to code this.. parsec, regex, text..+	-- but i don't want to bring in too many dependencies to this library.+	-- the date is like "YYYY:MM:DD HH:MM:SS"+	return $ LocalTime+		(fromGregorian (read $ take 4 dateStr) (read $ take 2 . drop 5 $ dateStr) (read $ take 2 . drop 8 $ dateStr))+		(TimeOfDay (read $ take 2 . drop 11 $ dateStr) (read $ take 2 . drop 14 $ dateStr) (read $ take 2 . drop 17 $ dateStr))
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Emmanuel Touzery++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Emmanuel Touzery nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsexif.cabal view
@@ -0,0 +1,42 @@+-- Initial hsexif.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                hsexif+version:             0.1.0.0+synopsis:            EXIF handling library in pure Haskell+-- description:         +homepage:            https://github.com/emmanueltouzery/hsexif+license:             BSD3+license-file:        LICENSE+author:              Emmanuel Touzery+maintainer:          etouzery@gmail.com+-- copyright:           +category:            Graphics+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Graphics.HsExif+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.6 && <4.7,+                       binary >=0.7 && <0.8,+                       bytestring >=0.10 && <0.11,+                       containers >= 0.5 && <0.6,+                       time >= 1.4 && <1.5+  -- hs-source-dirs:      +  default-language:    Haskell2010++test-suite             tests+  type:                 exitcode-stdio-1.0+  hs-source-dirs: ., tests+  main-is: Tests.hs+  default-language:    Haskell2010+  build-depends:       base,+                       hspec >= 1.8 && <1.9,+                       HUnit >= 1.2 && <1.3,+                       binary >=0.7 && <0.8,+                       bytestring >=0.10 && <0.11,+                       containers >= 0.5 && <0.6,+                       time >= 1.4 && <1.5
+ tests/Tests.hs view
@@ -0,0 +1,36 @@+import Test.Hspec+import Test.HUnit++import Graphics.HsExif+import qualified Data.ByteString.Lazy as B+import qualified Data.Map as Map+import Data.Time.LocalTime+import Data.Time.Calendar++main :: IO ()+main = do+	imageContents <- B.readFile "tests/test.jpg"+	noExif <- B.readFile "tests/noexif.jpg"+	png <- B.readFile "tests/test.png"+	hspec $ do+		describe "not a JPG" $ testNotAJpeg png+		describe "no EXIF" $ testNoExif noExif+		describe "basic parsing" $ testBasic imageContents+		describe "extract picture date" $ testDate imageContents++testNotAJpeg :: B.ByteString -> Spec+testNotAJpeg imageContents = it "returns empty list if not a JPEG" $+	assertEqual "doesn't match" (Left "Not a JPEG file") (parseExif imageContents)++testNoExif :: B.ByteString -> Spec+testNoExif imageContents = it "returns empty list if no EXIF" $+	assertEqual "doesn't match" (Left "No EXIF in JPEG") (parseExif imageContents)++testBasic :: B.ByteString -> Spec+testBasic imageContents = it "parses a simple JPEG" $+	assertEqual "doesn't match" (Right $ Map.fromList [(ExposureTime,"1/160"),(FNumber,"0/10"),(ExposureProgram,"2"),(ISOSpeedRatings,"1600"),(ExifVersion,"808661552"),(DateTimeOriginal,"2013:10:02 20:33:33"),(DateTimeDigitized,"2013:10:02 20:33:33"),(ComponentConfiguration,"197121"),(CompressedBitsPerPixel,"2/1"),(BrightnessValue,"-4226/2560"),(ExposureBiasValue,"0/10"),(MaxApertureValue,"0/10"),(MeteringMode,"5"),(LightSource,"0"),(Flash,"24"),(FocalLength,"0/10"),(MakerNote,"868"),(UserComment,"36568"),(FlashPixVersion,"808464688"),(ColorSpace,"1"),(ExifImageWidth,"1"),(ExifImageHeight,"1"),(ExifInteroperabilityOffset,"36640"),(FileSource,"3"),(SceneType,"1"),(Unknown 41985,"0"),(Unknown 41986,"0"),(Unknown 41987,"0"),(Unknown 41988,"16/16"),(Unknown 41989,"0"),(Unknown 41990,"0"),(Unknown 41992,"0"),(Unknown 41993,"0"),(Unknown 41994,"0")]) (parseExif imageContents)++testDate :: B.ByteString -> Spec+testDate imageContents = it "extracts the date correctly" $+	assertEqual "doesn't match" (Just $ LocalTime (fromGregorian 2013 10 2) (TimeOfDay 20 33 33))+		(getDateTimeOriginal $ (\(Right x) -> x) $ parseExif imageContents)