diff --git a/Graphics/ExifTags.hs b/Graphics/ExifTags.hs --- a/Graphics/ExifTags.hs +++ b/Graphics/ExifTags.hs @@ -35,8 +35,8 @@ showT :: Show a => a -> Text showT = T.pack . show -exposureTime = exifSubIfdTag "exposureTime" 0x829a $ withFormat "%s sec." -fnumber = exifSubIfdTag "fnumber" 0x829d $ withFormat "f/%s" +exposureTime = exifSubIfdTag "exposureTime" 0x829a $ ppExposureTime +fnumber = exifSubIfdTag "fnumber" 0x829d ppAperture exposureProgram = exifSubIfdTag "exposureProgram" 0x8822 ppExposureProgram spectralSensitivity = exifSubIfdTag "spectralSensitivity" 0x8824 showT isoSpeedRatings = exifSubIfdTag "isoSpeedRatings" 0x8827 showT @@ -46,11 +46,11 @@ dateTimeDigitized = exifSubIfdTag "dateTimeDigitized" 0x9004 showT componentConfiguration = exifSubIfdTag "componentConfiguration" 0x9101 ppComponentConfiguration compressedBitsPerPixel = exifSubIfdTag "compressedBitsPerPixel" 0x9102 (T.pack . formatAsFloatingPoint 2) -shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ withFormat "%s sec." -apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppAperture +shutterSpeedValue = exifSubIfdTag "shutterSpeedValue" 0x9201 $ ppExposureTime +apertureValue = exifSubIfdTag "apertureValue" 0x9202 ppApexAperture brightnessValue = exifSubIfdTag "brightnessValue" 0x9203 $ asFpWithFormat "%s EV" exposureBiasValue = exifSubIfdTag "exposureBiasValue" 0x9204 $ asFpWithFormat "%s EV" -maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 ppAperture +maxApertureValue = exifSubIfdTag "maxApertureValue" 0x9205 ppApexAperture subjectDistance = exifSubIfdTag "subjectDistance" 0x9206 showT meteringMode = exifSubIfdTag "meteringMode" 0x9207 ppMeteringMode lightSource = exifSubIfdTag "lightSource" 0x9208 ppLightSource diff --git a/Graphics/HsExif.hs b/Graphics/HsExif.hs --- a/Graphics/HsExif.hs +++ b/Graphics/HsExif.hs @@ -1,6 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} --- | Ability to work with the EXIF data contained in JPEG files. +-- | Ability to work with the EXIF data contained in image files. module Graphics.HsExif ( -- $intro @@ -188,9 +188,12 @@ firstBytes <- lookAhead $ (,) <$> getWord16be <*> getWord16be case firstBytes of (0xffd8,_ ) -> getWord16be >> findAndParseExifBlockJPEG - (0x4d4d,42) -> findAndParseExifBlockNEF -- DNG, Nikon - (0x4949,42) -> findAndParseExifBlockNEF - (0x4949,0x2A00) -> findAndParseExifBlockNEF -- TIFF, Canon CR2, Sony ARW + (0x4d4d,0x002A) -> findAndParseExifBlockTiff -- TIFF big-endian: DNG, Nikon + (0x4949,0x2A00) -> findAndParseExifBlockTiff -- TIFF little-endian: Canon CR2, Sony ARW + -- The following formats use the TIFF structure, but use their + -- own version number instead of 42. + (0x4949,0x524F) -> findAndParseExifBlockTiff -- Olympus ORF + (0x4949,0x5500) -> findAndParseExifBlockTiff -- Panasonic RW2 _ -> fail "Not a JPEG, TIFF, or TIFF-based raw file" findAndParseExifBlockJPEG :: Get (Map ExifTag ExifValue) @@ -204,10 +207,10 @@ 0xffda -> fail "No EXIF in JPEG" _ -> skip (dataSize-2) >> findAndParseExifBlockJPEG -findAndParseExifBlockNEF :: Get (Map ExifTag ExifValue) -findAndParseExifBlockNEF = parseTiff +findAndParseExifBlockTiff :: Get (Map ExifTag ExifValue) +findAndParseExifBlockTiff = parseTiff -data ByteAlign = Intel | Motorola +data ByteAlign = Intel | Motorola deriving (Eq) getWord16 :: ByteAlign -> Get Word16 getWord16 Intel = getWord16le @@ -254,7 +257,7 @@ "MM" -> return Motorola _ -> fail $ "Unknown byte alignment: " ++ byteAlignV alignControl <- toInteger <$> getWord16 byteAlign - unless (alignControl == 0x2a) + unless (alignControl == 0x2a || (byteAlign == Intel && (alignControl == 0x55 || alignControl == 0x4f52))) $ fail "exif byte alignment mismatch" ifdOffset <- fromIntegral . toInteger <$> getWord32 byteAlign skip $ ifdOffset - 8 @@ -542,7 +545,7 @@ -- $intro -- --- EXIF parsing from JPEG files. +-- EXIF parsing from JPEG and some RAW files. -- EXIF tags are enumerated as ExifTag values, check 'exposureTime' for instance. -- If you use the predefined ExifTag values, you don't care about details -- of the ExifTag type, however you should check out the 'ExifValue' type. diff --git a/Graphics/PrettyPrinters.hs b/Graphics/PrettyPrinters.hs --- a/Graphics/PrettyPrinters.hs +++ b/Graphics/PrettyPrinters.hs @@ -7,7 +7,6 @@ import qualified Data.Map as Map import qualified Data.ByteString as BS import Control.Arrow (first) -import Control.Applicative import Data.Text.Encoding import qualified Data.Text as T import Data.Text (Text) @@ -16,7 +15,7 @@ import Codec.Text.IConv (convertFuzzy, EncodingName, Fuzzy(Transliterate)) #endif -import Graphics.Types (ExifValue(..), formatAsFloatingPoint) +import Graphics.Types (ExifValue(..), formatAsFloatingPoint, formatAsNumber) -- ! Pretty print the undefined data ppUndef :: ExifValue -> Text @@ -33,6 +32,30 @@ ppAperture :: ExifValue -> Text ppAperture = T.pack . printf "f/%s" . formatAsFloatingPoint 1 + +-- ! Pretty-print aperture stored as APEX value. +-- See: https://photo.stackexchange.com/questions/19143/how-can-the-aperture-value-written-in-exif-be-larger-than-the-nominal-limit-of-t +ppApexAperture :: ExifValue -> Text +ppApexAperture v = T.pack (printf "f/%.1f" fnumber) + where + doubleValue :: ExifValue -> Double + doubleValue (ExifNumber n) = fromIntegral n + doubleValue (ExifRational n d) = fromIntegral n / fromIntegral d + doubleValue _ = 0 + apex = doubleValue v + fnumber = 2 ** (apex / 2) + +-- ! Pretty print exposure time. +-- Formats times slower than 1/4 with one decimal place and +-- faster times as fractions. +-- Examples: "4 sec.", "1/125 sec.", "0.8 sec." +ppExposureTime :: ExifValue -> Text +ppExposureTime v@(ExifRational num den) + = let seconds = fromIntegral num / (fromIntegral den :: Double) + value | seconds <= 0.25 && seconds > 0 = "1/" ++ show ((round (1 / seconds)) :: Int) + | otherwise = formatAsNumber 1 v + in T.append (T.pack value) " sec." +ppExposureTime v = T.pack (show v) ppExposureProgram :: ExifValue -> Text ppExposureProgram = fromNumberMap [(0, "Not defined"), diff --git a/Graphics/Types.hs b/Graphics/Types.hs --- a/Graphics/Types.hs +++ b/Graphics/Types.hs @@ -2,10 +2,8 @@ import qualified Data.ByteString as BS import Data.Word -import Numeric (showHex) +import Numeric (showHex, showFFloat) import Data.Function (on) -import Data.List -import Text.Printf (printf) import Data.Text (Text) -- | An exif value. @@ -99,11 +97,42 @@ -- the comma to format in the result string. -- The special behaviour applies only for 'ExifRational' and 'ExifRationalList'. formatAsFloatingPoint :: Int -> ExifValue -> String -formatAsFloatingPoint n (ExifRational num den) = formatNumDenAsString n num den -formatAsFloatingPoint n (ExifRationalList values) = intercalate ", " $ foldl' step [] values - where step soFar (num,den) = soFar ++ [formatNumDenAsString n num den] -formatAsFloatingPoint _ v = show v +formatAsFloatingPoint n = formatNumeric fmt + where + fmt num den = showFFloat (Just n) (fromIntegral num / fromIntegral den :: Double) -formatNumDenAsString :: Int -> Int -> Int -> String -formatNumDenAsString n num den = printf formatString (fromIntegral num / fromIntegral den :: Double) - where formatString = "%." ++ show n ++ "f" +-- | Format the exif value as a number if it makes sense, +-- otherwise use the default 'show' implementation. +-- The first parameter lets you specify the maximum number +-- of fractional digits in the result string. +-- This is the same as formatAsfloatingPoint but with trailing +-- zeros stripped from the result. +formatAsNumber :: Int -> ExifValue -> String +formatAsNumber n = formatNumeric fmt + where + fmt num den s = trim0 (fltString num den) ++ s + trim0 = reverse . dropWhile ('.'==) . dropWhile ('0'==) . reverse + fltString num den = showFFloat (Just n) (fromIntegral num / fromIntegral den :: Double) "" + +-- | Format the exif value as normalized rational number if it makes sense, +-- otherwise use the default 'show' implementation. +-- The special behaviour applies only for 'ExifRational' and 'ExifRationalList'. +formatAsRational :: ExifValue -> String +formatAsRational value = formatNumeric format value + where + format num den = let d = gcd num den + num' = num `quot` d + den' = den `quot` d + in + if den' == 1 + then shows num' + else shows num' . showChar '/' . shows den' + +formatNumeric :: (Int -> Int -> ShowS) -> ExifValue -> String +formatNumeric f (ExifRational num den) = f num den "" +formatNumeric f (ExifRationalList values) = go values "" + where + go [] = id + go [(n,d)] = f n d + go ((n,d):ns) = f n d . showString ", " . go ns +formatNumeric _ value = show value diff --git a/hsexif.cabal b/hsexif.cabal --- a/hsexif.cabal +++ b/hsexif.cabal @@ -1,5 +1,5 @@ name: hsexif -version: 0.6.1.3 +version: 0.6.1.4 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 @@ -15,6 +15,8 @@ import Control.Applicative ( (<$>) ) import Data.List +import Graphics.Types (formatAsRational) +import Graphics.PrettyPrinters (ppExposureTime) import Graphics.HsExif import Graphics.Helpers @@ -46,6 +48,8 @@ describe "read GPS lat long -- length 1 for rel" $ testReadGpsLatLong gps3ExifData 38.1785 (-7.2109) describe "test formatAsFloatingPoint" testFormatAsFloatingPoint + describe "test formatAsRational" testFormatAsRational + describe "test ppExposureTime" testPpExposureTime describe "pretty printing" $ testPrettyPrint gpsExifData exifData gps2ExifData describe "flash fired" $ testFlashFired exifData describe "partial exif data" $ testPartialExif partial @@ -154,6 +158,20 @@ testFormatAsFloatingPoint = it "properly formats as floating point" $ do assertEqual' "0.75" $ formatAsFloatingPoint 2 $ ExifRational 3 4 assertEqual' "0.75, -0.50, 0.25" $ formatAsFloatingPoint 2 $ ExifRationalList [(3,4),(-1,2),(1,4)] + +testFormatAsRational :: Spec +testFormatAsRational = it "properly formats as rational" $ do + assertEqual' "3/4" $ formatAsRational $ ExifRational 6 8 + assertEqual' "2" $ formatAsRational $ ExifRational 8 4 + assertEqual' "3/4, -1/2, 1/4" $ formatAsRational $ ExifRationalList [(3,4),(-1,2),(1,4)] + +testPpExposureTime :: Spec +testPpExposureTime = it "properly formats exposure time" $ do + assertEqual' "1.3 sec." $ ppExposureTime (ExifRational 13 10) + assertEqual' "8 sec." $ ppExposureTime (ExifRational 8 1) + assertEqual' "1/125 sec." $ ppExposureTime (ExifRational 10 1250) + assertEqual' "1/300 sec." $ ppExposureTime (ExifRational 10 3000) + assertEqual' "0.8 sec." $ ppExposureTime (ExifRational 10 13) testPrettyPrint :: Maybe (Map ExifTag ExifValue) -> Maybe (Map ExifTag ExifValue)