{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-- | Ability to work with the EXIF data contained in image files.
module Graphics.HsExif (
    -- $intro

    -- * Main functions
    parseFileExif,
    parseExif,

    -- * Higher-level helper functions
    readExifDateTime,
    getDateTimeOriginal,
    getOrientation,
    ImageOrientation(..),
    RotationDirection(..),
    getGpsLatitudeLongitude,
    wasFlashFired,
    formatAsFloatingPoint,
    getGpsDateTime,
    parseGpsTime,

    -- * The ExifValue type
    ExifValue(..),

    -- * Most useful exif tags
    exposureTime,
    fnumber,
    isoSpeedRatings,
    dateTimeOriginal,
    shutterSpeedValue,
    apertureValue,
    brightnessValue,
    exposureBiasValue,
    maxApertureValue,
    flash,
    focalLength,
    userComment,
    orientation,
    make,
    model,
    software,
    copyright,
    digitalZoomRatio,
    focalLengthIn35mmFilm,
    artist,

    -- * GPS related exif tags

    gpsVersionID,
    gpsLatitudeRef,
    gpsLatitude,
    gpsLongitudeRef,
    gpsLongitude,
    gpsAltitudeRef,
    gpsAltitude,
    gpsTimeStamp,
    gpsSatellites,
    gpsStatus,
    gpsMeasureMode,
    gpsDop,
    gpsSpeedRef,
    gpsSpeed,
    gpsTrackRef,
    gpsTrack,
    gpsImgDirectionRef,
    gpsImgDirection,
    gpsMapDatum,
    gpsDestLatitudeRef,
    gpsDestLatitude,
    gpsDestLongitudeRef,
    gpsDestLongitude,
    gpsDestBearingRef,
    gpsDestBearing,
    gpsDestDistanceRef,
    gpsDestDistance,
    gpsProcessingMethod,
    gpsAreaInformation,
    gpsDateStamp,
    gpsDifferential,

    -- * Less useful exif tags

    exifVersion,
    sensingMethod,
    fileSource,
    sceneType,
    makerNote,
    subjectDistance,
    meteringMode,
    lightSource,
    exifImageWidth,
    exifImageHeight,
    relatedSoundFile,
    focalPlaneXResolution,
    focalPlaneYResolution,
    focalPlaneResolutionUnit,
    dateTimeDigitized,
    componentConfiguration,
    compressedBitsPerPixel,
    exposureProgram,
    spectralSensitivity,
    oecf,
    subjectArea,
    subSecTime,
    subSecTimeOriginal,
    subSecTimeDigitized,
    flashPixVersion,
    colorSpace,
    flashEnergy,
    spatialFrequencyResponse,
    subjectLocation,
    exposureIndex,
    cfaPattern,
    customRendered,
    exposureMode,
    whiteBalance,
    sceneCaptureType,
    gainControl,
    contrast,
    saturation,
    sharpness,
    deviceSettingDescription,
    subjectDistanceRange,
    imageUniqueId,
    exifInteroperabilityOffset,
    imageDescription,
    xResolution,
    yResolution,
    resolutionUnit,
    dateTime,
    whitePoint,
    primaryChromaticities,
    yCbCrPositioning,
    yCbCrCoefficients,
    referenceBlackWhite,
    printImageMatching,

    -- * If you need to declare your own exif tags
    ExifTag(..),
    TagLocation(..),
) where

import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as BS
import Control.Monad
import Control.Applicative ( (<$>) )
import qualified Data.ByteString.Char8 as Char8
import Data.ByteString.Internal (w2c)
import Data.Word
import Data.Char (ord)
import Data.Int (Int32, Int16, Int8)
import Data.List
import Data.Maybe (fromMaybe, fromJust) -- TODO try to get rid of fromJust
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Time.LocalTime
import Data.Time.Calendar
import Data.Bits ((.&.))
import Control.Exception
import System.IO

import Graphics.Types (ExifValue(..), ExifTag(..), TagLocation(..), formatAsFloatingPoint)
import Graphics.ExifTags
import Graphics.Helpers

-- see http://www.media.mit.edu/pia/Research/deepview/exif.html
-- and http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf
-- and http://www.awaresystems.be/imaging/tiff/tifftags/privateifd/exif.html
-- and http://www.exiv2.org/tags.html
-- and https://libopenraw.freedesktop.org/wiki/Fuji_RAF/

-- | Read EXIF data from the file you give. It's a key-value map.
-- The reading is strict to avoid file handle exhaustion on a recursive
-- reading of a directory tree.
parseFileExif :: FilePath -> IO (Either String (Map ExifTag ExifValue))
parseFileExif :: FilePath -> IO (Either FilePath (Map ExifTag ExifValue))
parseFileExif FilePath
filename = FilePath
-> IOMode
-> (Handle -> IO (Either FilePath (Map ExifTag ExifValue)))
-> IO (Either FilePath (Map ExifTag ExifValue))
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
filename IOMode
ReadMode ((Either FilePath (Map ExifTag ExifValue)
-> IO (Either FilePath (Map ExifTag ExifValue))
forall a. a -> IO a
evaluate (Either FilePath (Map ExifTag ExifValue)
 -> IO (Either FilePath (Map ExifTag ExifValue)))
-> IO (Either FilePath (Map ExifTag ExifValue))
-> IO (Either FilePath (Map ExifTag ExifValue))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO (Either FilePath (Map ExifTag ExifValue))
 -> IO (Either FilePath (Map ExifTag ExifValue)))
-> (Handle -> IO (Either FilePath (Map ExifTag ExifValue)))
-> Handle
-> IO (Either FilePath (Map ExifTag ExifValue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either FilePath (Map ExifTag ExifValue))
-> IO ByteString -> IO (Either FilePath (Map ExifTag ExifValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either FilePath (Map ExifTag ExifValue)
parseExif (IO ByteString -> IO (Either FilePath (Map ExifTag ExifValue)))
-> (Handle -> IO ByteString)
-> Handle
-> IO (Either FilePath (Map ExifTag ExifValue))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B.hGetContents)

-- | Read EXIF data from a lazy bytestring.
parseExif :: B.ByteString -> Either String (Map ExifTag ExifValue)
parseExif :: ByteString -> Either FilePath (Map ExifTag ExifValue)
parseExif = Get (Map ExifTag ExifValue)
-> ByteString -> Either FilePath (Map ExifTag ExifValue)
forall a. Get a -> ByteString -> Either FilePath a
runEitherGet Get (Map ExifTag ExifValue)
getExif

getExif :: Get (Map ExifTag ExifValue)
getExif :: Get (Map ExifTag ExifValue)
getExif = do
    (Word16, Word16)
firstBytes <- Get (Word16, Word16) -> Get (Word16, Word16)
forall a. Get a -> Get a
lookAhead (Get (Word16, Word16) -> Get (Word16, Word16))
-> Get (Word16, Word16) -> Get (Word16, Word16)
forall a b. (a -> b) -> a -> b
$ (,) (Word16 -> Word16 -> (Word16, Word16))
-> Get Word16 -> Get (Word16 -> (Word16, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get (Word16 -> (Word16, Word16))
-> Get Word16 -> Get (Word16, Word16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
    case (Word16, Word16)
firstBytes of
        (Word16
0xffd8,Word16
_ ) -> Get Word16
getWord16be Get Word16
-> Get (Map ExifTag ExifValue) -> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG
        (Word16
0x4d4d,Word16
0x002A) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff  -- TIFF big-endian: DNG, Nikon
        (Word16
0x4949,Word16
0x2A00) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff  -- TIFF little-endian: Canon CR2, Sony ARW
        -- The following formats use the TIFF structure, but use their
        -- own version number instead of 42.
        (Word16
0x4949,Word16
0x524F) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff  -- Olympus ORF
        (Word16
0x4949,Word16
0x5500) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff  -- Panasonic RW2
        -- Fuji RAF files use a custom format with an embedded JPEG preview containing the EXIF data
        (Word16
0x4655,Word16
0x4A49) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockFuji  -- Fuji RAF
        (Word16, Word16)
_           -> FilePath -> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Not a JPEG, TIFF, RAF, or TIFF-based raw file"

findAndParseExifBlockJPEG :: Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG :: Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG = do
    Word16
markerNumber <- Get Word16
getWord16be
    Int
dataSize <- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (Word16 -> Integer) -> Word16 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
    case Word16
markerNumber of
        Word16
0xffe1 -> Get (Either Int (Map ExifTag ExifValue))
tryParseExifBlock Get (Either Int (Map ExifTag ExifValue))
-> (Either Int (Map ExifTag ExifValue)
    -> Get (Map ExifTag ExifValue))
-> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Right Map ExifTag ExifValue
exif -> Map ExifTag ExifValue -> Get (Map ExifTag ExifValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ExifTag ExifValue
exif
          -- try will fail for XMP content for instance
          Left Int
bytesReadByTry -> Int -> Get ()
skip (Int
dataSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bytesReadByTry) Get ()
-> Get (Map ExifTag ExifValue) -> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG
        -- ffda is Start Of Stream => image
        -- I expect no more EXIF data after this point.
        Word16
0xffda -> FilePath -> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"No EXIF in JPEG"
        Word16
_ -> Int -> Get ()
skip (Int
dataSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Get ()
-> Get (Map ExifTag ExifValue) -> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG

findAndParseExifBlockTiff :: Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff :: Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff = Get (Map ExifTag ExifValue)
parseTiff

findAndParseExifBlockFuji :: Get (Map ExifTag ExifValue)
findAndParseExifBlockFuji :: Get (Map ExifTag ExifValue)
findAndParseExifBlockFuji = do
    ByteString
header <- Int -> Get ByteString
getByteString Int
16
    ByteString
version <- Int -> Get ByteString
getByteString Int
4
    Int -> Get ()
skip Int
64
    Word32
jpegOffset <- Get Word32
getWord32be
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
header ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"FUJIFILMCCD-RAW " Bool -> Bool -> Bool
&& ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"0201") (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Incorrect RAF header"
    Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$
      Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
jpegOffset  -- skip to jpeg data (offset is from start of file)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16                     -- 16 bytes for header
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4                      -- 4 bytes for version
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
64                     -- 64 other bytes skiped
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4                      -- 4 bytes jpeg offset
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2                      -- findAndParseExifBlockJPEG expects 2 bytes skipped
    Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG

data ByteAlign = Intel | Motorola deriving (ByteAlign -> ByteAlign -> Bool
(ByteAlign -> ByteAlign -> Bool)
-> (ByteAlign -> ByteAlign -> Bool) -> Eq ByteAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteAlign -> ByteAlign -> Bool
$c/= :: ByteAlign -> ByteAlign -> Bool
== :: ByteAlign -> ByteAlign -> Bool
$c== :: ByteAlign -> ByteAlign -> Bool
Eq)

getWord16 :: ByteAlign -> Get Word16
getWord16 :: ByteAlign -> Get Word16
getWord16 ByteAlign
Intel = Get Word16
getWord16le
getWord16 ByteAlign
Motorola = Get Word16
getWord16be

getWord32 :: ByteAlign -> Get Word32
getWord32 :: ByteAlign -> Get Word32
getWord32 ByteAlign
Intel = Get Word32
getWord32le
getWord32 ByteAlign
Motorola = Get Word32
getWord32be

putWord32 :: ByteAlign -> Word32 -> Put
putWord32 :: ByteAlign -> Word32 -> Put
putWord32 ByteAlign
Intel = Word32 -> Put
putWord32le
putWord32 ByteAlign
Motorola = Word32 -> Put
putWord32be

-- return either the exif info, or the number of bytes read.
tryParseExifBlock :: Get (Either Int (Map ExifTag ExifValue))
tryParseExifBlock :: Get (Either Int (Map ExifTag ExifValue))
tryParseExifBlock = do
    ByteString
header <- Int -> Get ByteString
getByteString Int
4
    Integer
nul <- Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
    if ByteString
header ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
Char8.pack FilePath
"Exif" Bool -> Bool -> Bool
&& Integer
nul Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then Map ExifTag ExifValue -> Either Int (Map ExifTag ExifValue)
forall a b. b -> Either a b
Right (Map ExifTag ExifValue -> Either Int (Map ExifTag ExifValue))
-> Get (Map ExifTag ExifValue)
-> Get (Either Int (Map ExifTag ExifValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Map ExifTag ExifValue)
parseTiff
      else Either Int (Map ExifTag ExifValue)
-> Get (Either Int (Map ExifTag ExifValue))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Int (Map ExifTag ExifValue)
forall a b. a -> Either a b
Left Int
6) -- read 6 bytes: 4+2

parseTiff :: Get (Map ExifTag ExifValue)
parseTiff :: Get (Map ExifTag ExifValue)
parseTiff = do
    (ByteAlign
byteAlign, Int
ifdOffset) <- Get (ByteAlign, Int) -> Get (ByteAlign, Int)
forall a. Get a -> Get a
lookAhead Get (ByteAlign, Int)
parseTiffHeader
    [(ExifTag, ExifValue)]
tags <- ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)]
parseIfd ByteAlign
byteAlign TagLocation
IFD0 Int
ifdOffset
    Map ExifTag ExifValue -> Get (Map ExifTag ExifValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ExifTag ExifValue -> Get (Map ExifTag ExifValue))
-> Map ExifTag ExifValue -> Get (Map ExifTag ExifValue)
forall a b. (a -> b) -> a -> b
$ [(ExifTag, ExifValue)] -> Map ExifTag ExifValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ExifTag, ExifValue)]
tags

parseTiffHeader :: Get (ByteAlign, Int)
parseTiffHeader :: Get (ByteAlign, Int)
parseTiffHeader = do
    FilePath
byteAlignV <- ByteString -> FilePath
Char8.unpack (ByteString -> FilePath) -> Get ByteString -> Get FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
2
    ByteAlign
byteAlign <- case FilePath
byteAlignV of
        FilePath
"II" -> ByteAlign -> Get ByteAlign
forall (m :: * -> *) a. Monad m => a -> m a
return ByteAlign
Intel
        FilePath
"MM" -> ByteAlign -> Get ByteAlign
forall (m :: * -> *) a. Monad m => a -> m a
return ByteAlign
Motorola
        FilePath
_ -> FilePath -> Get ByteAlign
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Get ByteAlign) -> FilePath -> Get ByteAlign
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown byte alignment: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
byteAlignV
    Integer
alignControl <- Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word16
getWord16 ByteAlign
byteAlign
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
alignControl Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0x2a Bool -> Bool -> Bool
|| (ByteAlign
byteAlign ByteAlign -> ByteAlign -> Bool
forall a. Eq a => a -> a -> Bool
== ByteAlign
Intel Bool -> Bool -> Bool
&& (Integer
alignControl Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0x55 Bool -> Bool -> Bool
|| Integer
alignControl Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0x4f52)))
        (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"exif byte alignment mismatch"
    Int
ifdOffset <- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (Word32 -> Integer) -> Word32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
    (ByteAlign, Int) -> Get (ByteAlign, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteAlign
byteAlign, Int
ifdOffset)

-- | Parse an Image File Directory table
parseIfd :: ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)]
parseIfd :: ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)]
parseIfd ByteAlign
byteAlign TagLocation
ifdId Int
offset = do
    [IfEntry]
entries <- Get [IfEntry] -> Get [IfEntry]
forall a. Get a -> Get a
lookAhead (Get [IfEntry] -> Get [IfEntry]) -> Get [IfEntry] -> Get [IfEntry]
forall a b. (a -> b) -> a -> b
$ do
        Int -> Get ()
skip Int
offset
        Int
dirEntriesCount <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word16
getWord16 ByteAlign
byteAlign
        Int -> Get IfEntry -> Get [IfEntry]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
dirEntriesCount (ByteAlign -> TagLocation -> Get IfEntry
parseIfEntry ByteAlign
byteAlign TagLocation
ifdId)
    
    [[(ExifTag, ExifValue)]] -> [(ExifTag, ExifValue)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ExifTag, ExifValue)]] -> [(ExifTag, ExifValue)])
-> Get [[(ExifTag, ExifValue)]] -> Get [(ExifTag, ExifValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IfEntry -> Get [(ExifTag, ExifValue)])
-> [IfEntry] -> Get [[(ExifTag, ExifValue)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ByteAlign -> IfEntry -> Get [(ExifTag, ExifValue)]
entryTags ByteAlign
byteAlign) [IfEntry]
entries

-- | Convert IFD entries to tags, reading sub-IFDs
entryTags :: ByteAlign -> IfEntry -> Get [(ExifTag, ExifValue)]
entryTags :: ByteAlign -> IfEntry -> Get [(ExifTag, ExifValue)]
entryTags ByteAlign
_ (Tag ExifTag
tag Get ExifValue
parseValue) = Get ExifValue
parseValue Get ExifValue
-> (ExifValue -> Get [(ExifTag, ExifValue)])
-> Get [(ExifTag, ExifValue)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ExifValue
value -> [(ExifTag, ExifValue)] -> Get [(ExifTag, ExifValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ExifTag
tag, ExifValue
value)]
entryTags ByteAlign
byteAlign (SubIFD TagLocation
ifdId Int
offset) = Get [(ExifTag, ExifValue)] -> Get [(ExifTag, ExifValue)]
forall a. Get a -> Get a
lookAhead (ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)]
parseIfd ByteAlign
byteAlign TagLocation
ifdId Int
offset)

data IfEntry = Tag ExifTag (Get ExifValue) | SubIFD TagLocation Int

-- | Parse a single IFD entry
parseIfEntry :: ByteAlign -> TagLocation -> Get IfEntry
parseIfEntry :: ByteAlign -> TagLocation -> Get IfEntry
parseIfEntry ByteAlign
byteAlign TagLocation
ifdId = do
    Word16
tagNumber <- ByteAlign -> Get Word16
getWord16 ByteAlign
byteAlign
    Word16
format <- ByteAlign -> Get Word16
getWord16 ByteAlign
byteAlign
    Int
numComponents <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
    Word32
content <- ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign

    IfEntry -> Get IfEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (IfEntry -> Get IfEntry) -> IfEntry -> Get IfEntry
forall a b. (a -> b) -> a -> b
$ case (TagLocation
ifdId, Word16
tagNumber) of
        (TagLocation
IFD0, Word16
0x8769) -> TagLocation -> Int -> IfEntry
SubIFD TagLocation
ExifSubIFD (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
content)
        (TagLocation
IFD0, Word16
0x8825) -> TagLocation -> Int -> IfEntry
SubIFD TagLocation
GpsSubIFD  (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
content)
        (TagLocation
_, Word16
tagId)     -> ExifTag -> Get ExifValue -> IfEntry
Tag (TagLocation -> Word16 -> ExifTag
getExifTag TagLocation
ifdId Word16
tagId) (ByteAlign -> Word16 -> Int -> Word32 -> Get ExifValue
decodeEntry ByteAlign
byteAlign Word16
format Int
numComponents Word32
content)

getExifTag :: TagLocation -> Word16 -> ExifTag
getExifTag :: TagLocation -> Word16 -> ExifTag
getExifTag TagLocation
l Word16
v = ExifTag -> Maybe ExifTag -> ExifTag
forall a. a -> Maybe a -> a
fromMaybe (TagLocation
-> Maybe FilePath -> Word16 -> (ExifValue -> Text) -> ExifTag
ExifTag TagLocation
l Maybe FilePath
forall a. Maybe a
Nothing Word16
v ExifValue -> Text
forall a. Show a => a -> Text
showT) (Maybe ExifTag -> ExifTag) -> Maybe ExifTag -> ExifTag
forall a b. (a -> b) -> a -> b
$ (ExifTag -> Bool) -> [ExifTag] -> Maybe ExifTag
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (TagLocation -> Word16 -> ExifTag -> Bool
isSameTag TagLocation
l Word16
v) [ExifTag]
allExifTags
    where isSameTag :: TagLocation -> Word16 -> ExifTag -> Bool
isSameTag TagLocation
l1 Word16
v1 (ExifTag TagLocation
l2 Maybe FilePath
_ Word16
v2 ExifValue -> Text
_) = TagLocation
l1 TagLocation -> TagLocation -> Bool
forall a. Eq a => a -> a -> Bool
== TagLocation
l2 Bool -> Bool -> Bool
&& Word16
v1 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
v2

data ValueHandler = ValueHandler
    {
        ValueHandler -> Word16
dataTypeId :: Word16,
        ValueHandler -> Int
dataLength :: Int,
        ValueHandler -> ByteAlign -> Get ExifValue
readSingle :: ByteAlign -> Get ExifValue,
        ValueHandler -> ByteAlign -> Int -> Get ExifValue
readMany :: ByteAlign -> Int -> Get ExifValue
    }

readNumberList :: Integral a => (ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList :: (ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ByteAlign -> Get a
decoder ByteAlign
byteAlign Int
components = [Int] -> ExifValue
ExifNumberList ([Int] -> ExifValue) -> ([a] -> [Int]) -> [a] -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> ExifValue) -> Get [a] -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Int -> Get a -> Get [a]
forall a. Int -> Get a -> Get [a]
count Int
components (ByteAlign -> Get a
decoder ByteAlign
byteAlign)

decodeTextByteString :: BS.ByteString -> String
decodeTextByteString :: ByteString -> FilePath
decodeTextByteString ByteString
bs = Word8 -> Char
w2c (Word8 -> Char) -> [Word8] -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8]
strippedWords
    where
      strippedWords :: [Word8]
strippedWords = if Bool -> Bool
not ([Word8] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
bsWords) Bool -> Bool -> Bool
&& [Word8] -> Word8
forall a. [a] -> a
last [Word8]
bsWords Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
                      then [Word8] -> [Word8]
forall a. [a] -> [a]
init [Word8]
bsWords
                      else [Word8]
bsWords
      bsWords :: [Word8]
bsWords = ByteString -> [Word8]
BS.unpack ByteString
bs

unsignedByteValueHandler :: ValueHandler
unsignedByteValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
1,
        dataLength :: Int
dataLength = Int
1,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = \ByteAlign
_ -> Int -> ExifValue
ExifNumber (Int -> ExifValue) -> (Word8 -> Int) -> Word8 -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ExifValue) -> Get Word8 -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = (ByteAlign -> Get Word8) -> ByteAlign -> Int -> Get ExifValue
forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ((ByteAlign -> Get Word8) -> ByteAlign -> Int -> Get ExifValue)
-> (ByteAlign -> Get Word8) -> ByteAlign -> Int -> Get ExifValue
forall a b. (a -> b) -> a -> b
$ Get Word8 -> ByteAlign -> Get Word8
forall a b. a -> b -> a
const Get Word8
getWord8
    }

asciiStringValueHandler :: ValueHandler
asciiStringValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
2,
        dataLength :: Int
dataLength = Int
1,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = \ByteAlign
ba -> ValueHandler -> ByteAlign -> Int -> Get ExifValue
readMany ValueHandler
asciiStringValueHandler ByteAlign
ba Int
1,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = \ByteAlign
_ Int
components -> FilePath -> ExifValue
ExifText (FilePath -> ExifValue)
-> (ByteString -> FilePath) -> ByteString -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
decodeTextByteString (ByteString -> ExifValue) -> Get ByteString -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
components
    }

unsignedShortValueHandler :: ValueHandler
unsignedShortValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
3,
        dataLength :: Int
dataLength = Int
2,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = (Word16 -> ExifValue) -> Get Word16 -> Get ExifValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ExifValue
ExifNumber (Int -> ExifValue) -> (Word16 -> Int) -> Word16 -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Get Word16 -> Get ExifValue)
-> (ByteAlign -> Get Word16) -> ByteAlign -> Get ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word16
getWord16,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = (ByteAlign -> Get Word16) -> ByteAlign -> Int -> Get ExifValue
forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ByteAlign -> Get Word16
getWord16
    }

unsignedLongValueHandler :: ValueHandler
unsignedLongValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
4,
        dataLength :: Int
dataLength = Int
4,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = (Word32 -> ExifValue) -> Get Word32 -> Get ExifValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ExifValue
ExifNumber (Int -> ExifValue) -> (Word32 -> Int) -> Word32 -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Get Word32 -> Get ExifValue)
-> (ByteAlign -> Get Word32) -> ByteAlign -> Get ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word32
getWord32,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = (ByteAlign -> Get Word32) -> ByteAlign -> Int -> Get ExifValue
forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ByteAlign -> Get Word32
getWord32
    }

readRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents Int -> Int -> a
c ByteAlign
byteAlign = do
    Int
numerator   <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
    Int
denominator <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a
c Int
numerator Int
denominator

unsignedRationalValueHandler :: ValueHandler
unsignedRationalValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
5,
        dataLength :: Int
dataLength = Int
8,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = (Int -> Int -> ExifValue) -> ByteAlign -> Get ExifValue
forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents Int -> Int -> ExifValue
ExifRational,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = \ByteAlign
byteAlign Int
components -> [(Int, Int)] -> ExifValue
ExifRationalList ([(Int, Int)] -> ExifValue) -> Get [(Int, Int)] -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get (Int, Int) -> Get [(Int, Int)]
forall a. Int -> Get a -> Get [a]
count Int
components ((Int -> Int -> (Int, Int)) -> ByteAlign -> Get (Int, Int)
forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents (,) ByteAlign
byteAlign)
    }

signedByteValueHandler :: ValueHandler
signedByteValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
6,
        dataLength :: Int
dataLength = Int
1,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = \ByteAlign
_ -> Int -> ExifValue
ExifNumber (Int -> ExifValue) -> (Word8 -> Int) -> Word8 -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
signedInt8ToInt (Word8 -> ExifValue) -> Get Word8 -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = (ByteAlign -> Get Int) -> ByteAlign -> Int -> Get ExifValue
forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ((Word8 -> Int) -> Get Word8 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Int
signedInt8ToInt (Get Word8 -> Get Int)
-> (ByteAlign -> Get Word8) -> ByteAlign -> Get Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Word8 -> ByteAlign -> Get Word8
forall a b. a -> b -> a
const Get Word8
getWord8)
    }

undefinedValueHandler :: ValueHandler
undefinedValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
7,
        dataLength :: Int
dataLength = Int
1,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = \ByteAlign
ba -> ValueHandler -> ByteAlign -> Int -> Get ExifValue
readMany ValueHandler
undefinedValueHandler ByteAlign
ba Int
1,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = \ByteAlign
_ Int
components -> ByteString -> ExifValue
ExifUndefined (ByteString -> ExifValue) -> Get ByteString -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
components
    }

signedShortValueHandler :: ValueHandler
signedShortValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
8,
        dataLength :: Int
dataLength = Int
2,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = (Word16 -> ExifValue) -> Get Word16 -> Get ExifValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ExifValue
ExifNumber (Int -> ExifValue) -> (Word16 -> Int) -> Word16 -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
signedInt16ToInt) (Get Word16 -> Get ExifValue)
-> (ByteAlign -> Get Word16) -> ByteAlign -> Get ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word16
getWord16,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = (ByteAlign -> Get Int) -> ByteAlign -> Int -> Get ExifValue
forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ((Word16 -> Int) -> Get Word16 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word16 -> Int
signedInt16ToInt (Get Word16 -> Get Int)
-> (ByteAlign -> Get Word16) -> ByteAlign -> Get Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word16
getWord16)
    }

signedLongValueHandler :: ValueHandler
signedLongValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
9,
        dataLength :: Int
dataLength = Int
4,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = (Word32 -> ExifValue) -> Get Word32 -> Get ExifValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ExifValue
ExifNumber (Int -> ExifValue) -> (Word32 -> Int) -> Word32 -> ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
signedInt32ToInt) (Get Word32 -> Get ExifValue)
-> (ByteAlign -> Get Word32) -> ByteAlign -> Get ExifValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word32
getWord32,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = (ByteAlign -> Get Int) -> ByteAlign -> Int -> Get ExifValue
forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ((Word32 -> Int) -> Get Word32 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Int
signedInt32ToInt (Get Word32 -> Get Int)
-> (ByteAlign -> Get Word32) -> ByteAlign -> Get Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word32
getWord32)
    }

readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a
readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a
readSignedRationalContents Int -> Int -> a
c ByteAlign
byteAlign = do
    Int
numerator   <- Word32 -> Int
signedInt32ToInt (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
    Int
denominator <- Word32 -> Int
signedInt32ToInt (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a
c Int
numerator Int
denominator

signedRationalValueHandler :: ValueHandler
signedRationalValueHandler = ValueHandler :: Word16
-> Int
-> (ByteAlign -> Get ExifValue)
-> (ByteAlign -> Int -> Get ExifValue)
-> ValueHandler
ValueHandler
    {
        dataTypeId :: Word16
dataTypeId = Word16
10,
        dataLength :: Int
dataLength = Int
8,
        readSingle :: ByteAlign -> Get ExifValue
readSingle = (Int -> Int -> ExifValue) -> ByteAlign -> Get ExifValue
forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readSignedRationalContents Int -> Int -> ExifValue
ExifRational,
        readMany :: ByteAlign -> Int -> Get ExifValue
readMany = \ByteAlign
byteAlign Int
components -> [(Int, Int)] -> ExifValue
ExifRationalList ([(Int, Int)] -> ExifValue) -> Get [(Int, Int)] -> Get ExifValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Int -> Get (Int, Int) -> Get [(Int, Int)]
forall a. Int -> Get a -> Get [a]
count Int
components ((Int -> Int -> (Int, Int)) -> ByteAlign -> Get (Int, Int)
forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readSignedRationalContents (,) ByteAlign
byteAlign)
    }

valueHandlers :: [ValueHandler]
valueHandlers :: [ValueHandler]
valueHandlers =
    [
        ValueHandler
unsignedByteValueHandler,
        ValueHandler
asciiStringValueHandler,
        ValueHandler
unsignedShortValueHandler,
        ValueHandler
unsignedLongValueHandler,
        ValueHandler
unsignedRationalValueHandler,
        ValueHandler
signedByteValueHandler,
        ValueHandler
signedShortValueHandler,
        ValueHandler
signedLongValueHandler,
        ValueHandler
signedRationalValueHandler,
        ValueHandler
undefinedValueHandler
    ]

decodeEntry :: ByteAlign -> Word16 -> Int -> Word32 -> Get ExifValue
decodeEntry :: ByteAlign -> Word16 -> Int -> Word32 -> Get ExifValue
decodeEntry ByteAlign
byteAlign Word16
format Int
amount Word32
payload = do
    case Word16 -> Maybe ValueHandler
getHandler Word16
format of
        Just ValueHandler
handler | ValueHandler -> Bool
isInline ValueHandler
handler -> ExifValue -> Get ExifValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExifValue -> Get ExifValue) -> ExifValue -> Get ExifValue
forall a b. (a -> b) -> a -> b
$ ByteAlign -> ValueHandler -> Int -> ByteString -> ExifValue
parseInline ByteAlign
byteAlign ValueHandler
handler Int
amount (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteAlign -> Word32 -> Put
putWord32 ByteAlign
byteAlign Word32
payload)
        Just ValueHandler
handler                    -> ByteAlign -> ValueHandler -> Int -> Word32 -> Get ExifValue
parseOffset ByteAlign
byteAlign ValueHandler
handler Int
amount Word32
payload
        Maybe ValueHandler
Nothing -> ExifValue -> Get ExifValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExifValue -> Get ExifValue) -> ExifValue -> Get ExifValue
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Int -> ExifValue
ExifUnknown Word16
format Int
amount (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
payload)
    where
        isInline :: ValueHandler -> Bool
isInline ValueHandler
handler = ValueHandler -> Int
dataLength ValueHandler
handler Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
amount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4

getHandler :: Word16 -> Maybe ValueHandler
getHandler :: Word16 -> Maybe ValueHandler
getHandler Word16
typeId = (ValueHandler -> Bool) -> [ValueHandler] -> Maybe ValueHandler
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
==Word16
typeId) (Word16 -> Bool)
-> (ValueHandler -> Word16) -> ValueHandler -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueHandler -> Word16
dataTypeId) [ValueHandler]
valueHandlers

parseInline :: ByteAlign -> ValueHandler -> Int -> B.ByteString -> ExifValue
parseInline :: ByteAlign -> ValueHandler -> Int -> ByteString -> ExifValue
parseInline ByteAlign
byteAlign ValueHandler
handler Int
amount ByteString
bytestring =
    Maybe ExifValue -> ExifValue
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ExifValue -> ExifValue) -> Maybe ExifValue -> ExifValue
forall a b. (a -> b) -> a -> b
$ Get ExifValue -> ByteString -> Maybe ExifValue
forall a. Get a -> ByteString -> Maybe a
runMaybeGet Get ExifValue
getter ByteString
bytestring
    where
        getter :: Get ExifValue
getter = case Int
amount of
            Int
1 -> ValueHandler -> ByteAlign -> Get ExifValue
readSingle ValueHandler
handler ByteAlign
byteAlign
            Int
_ -> ValueHandler -> ByteAlign -> Int -> Get ExifValue
readMany ValueHandler
handler ByteAlign
byteAlign Int
amount

parseOffset :: ByteAlign -> ValueHandler -> Int -> Word32 -> Get ExifValue
parseOffset :: ByteAlign -> ValueHandler -> Int -> Word32 -> Get ExifValue
parseOffset ByteAlign
byteAlign ValueHandler
handler Int
amount Word32
offset = do
    -- this skip can take me quite far and I can't skip
    -- back with binary. So do the skip with a lookAhead.
    -- see https://github.com/emmanueltouzery/hsexif/issues/9
    Get ExifValue -> Get ExifValue
forall a. Get a -> Get a
lookAhead (Get ExifValue -> Get ExifValue) -> Get ExifValue -> Get ExifValue
forall a b. (a -> b) -> a -> b
$ do
        Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset)
        let bsLength :: Int
bsLength = Int
amount Int -> Int -> Int
forall a. Num a => a -> a -> a
* ValueHandler -> Int
dataLength ValueHandler
handler
        ByteString
bytestring <- Int64 -> Get ByteString
getLazyByteString (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLength)
        ExifValue -> Get ExifValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteAlign -> ValueHandler -> Int -> ByteString -> ExifValue
parseInline ByteAlign
byteAlign ValueHandler
handler Int
amount ByteString
bytestring)

signedInt32ToInt :: Word32 -> Int
signedInt32ToInt :: Word32 -> Int
signedInt32ToInt Word32
w = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w :: Int32)

signedInt16ToInt :: Word16 -> Int
signedInt16ToInt :: Word16 -> Int
signedInt16ToInt Word16
w = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w :: Int16)

signedInt8ToInt :: Word8 -> Int
signedInt8ToInt :: Word8 -> Int
signedInt8ToInt Word8
w = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w :: Int8)

-- | Decode an EXIF date time value.
-- Will return 'Nothing' in case parsing fails.
readExifDateTime :: String -> Maybe LocalTime
readExifDateTime :: FilePath -> Maybe LocalTime
readExifDateTime FilePath
dateStr = Get LocalTime -> ByteString -> Maybe LocalTime
forall a. Get a -> ByteString -> Maybe a
runMaybeGet Get LocalTime
getExifDateTime (ByteString -> Maybe LocalTime) -> ByteString -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> FilePath -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) FilePath
dateStr

getExifDateTime :: Get LocalTime
getExifDateTime :: Get LocalTime
getExifDateTime = do
    Integer
year   <- Int -> Get Integer
forall a. Read a => Int -> Get a
readDigit Int
4
    Int
month  <- Char -> Get Char
getCharValue Char
':' Get Char -> Get Int -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Int
forall a. Read a => Int -> Get a
readDigit Int
2
    Int
day    <- Char -> Get Char
getCharValue Char
':' Get Char -> Get Int -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Int
forall a. Read a => Int -> Get a
readDigit Int
2
    Int
hour   <- Char -> Get Char
getCharValue Char
' ' Get Char -> Get Int -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Int
forall a. Read a => Int -> Get a
readDigit Int
2
    Int
minute <- Char -> Get Char
getCharValue Char
':' Get Char -> Get Int -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Int
forall a. Read a => Int -> Get a
readDigit Int
2
    Pico
second <- Char -> Get Char
getCharValue Char
':' Get Char -> Get Pico -> Get Pico
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get Pico
forall a. Read a => Int -> Get a
readDigit Int
2
    LocalTime -> Get LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> Get LocalTime) -> LocalTime -> Get LocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
hour Int
minute Pico
second)

-- | Extract the date and time when the picture was taken
-- from the EXIF information.
getDateTimeOriginal :: Map ExifTag ExifValue -> Maybe LocalTime
getDateTimeOriginal :: Map ExifTag ExifValue -> Maybe LocalTime
getDateTimeOriginal Map ExifTag ExifValue
exifData = ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
dateTimeOriginal Map ExifTag ExifValue
exifData Maybe ExifValue
-> (ExifValue -> Maybe LocalTime) -> Maybe LocalTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe LocalTime
readExifDateTime (FilePath -> Maybe LocalTime)
-> (ExifValue -> FilePath) -> ExifValue -> Maybe LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExifValue -> FilePath
forall a. Show a => a -> FilePath
show

data RotationDirection = MinusNinety
    | Ninety
    | HundredAndEighty
    deriving (Int -> RotationDirection -> FilePath -> FilePath
[RotationDirection] -> FilePath -> FilePath
RotationDirection -> FilePath
(Int -> RotationDirection -> FilePath -> FilePath)
-> (RotationDirection -> FilePath)
-> ([RotationDirection] -> FilePath -> FilePath)
-> Show RotationDirection
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [RotationDirection] -> FilePath -> FilePath
$cshowList :: [RotationDirection] -> FilePath -> FilePath
show :: RotationDirection -> FilePath
$cshow :: RotationDirection -> FilePath
showsPrec :: Int -> RotationDirection -> FilePath -> FilePath
$cshowsPrec :: Int -> RotationDirection -> FilePath -> FilePath
Show, RotationDirection -> RotationDirection -> Bool
(RotationDirection -> RotationDirection -> Bool)
-> (RotationDirection -> RotationDirection -> Bool)
-> Eq RotationDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RotationDirection -> RotationDirection -> Bool
$c/= :: RotationDirection -> RotationDirection -> Bool
== :: RotationDirection -> RotationDirection -> Bool
$c== :: RotationDirection -> RotationDirection -> Bool
Eq)

data ImageOrientation = Normal
    | Mirror
    | Rotation RotationDirection
    | MirrorRotation RotationDirection
    deriving (Int -> ImageOrientation -> FilePath -> FilePath
[ImageOrientation] -> FilePath -> FilePath
ImageOrientation -> FilePath
(Int -> ImageOrientation -> FilePath -> FilePath)
-> (ImageOrientation -> FilePath)
-> ([ImageOrientation] -> FilePath -> FilePath)
-> Show ImageOrientation
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ImageOrientation] -> FilePath -> FilePath
$cshowList :: [ImageOrientation] -> FilePath -> FilePath
show :: ImageOrientation -> FilePath
$cshow :: ImageOrientation -> FilePath
showsPrec :: Int -> ImageOrientation -> FilePath -> FilePath
$cshowsPrec :: Int -> ImageOrientation -> FilePath -> FilePath
Show, ImageOrientation -> ImageOrientation -> Bool
(ImageOrientation -> ImageOrientation -> Bool)
-> (ImageOrientation -> ImageOrientation -> Bool)
-> Eq ImageOrientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageOrientation -> ImageOrientation -> Bool
$c/= :: ImageOrientation -> ImageOrientation -> Bool
== :: ImageOrientation -> ImageOrientation -> Bool
$c== :: ImageOrientation -> ImageOrientation -> Bool
Eq)

-- | Extract the image orientation from the EXIF information.
-- Will return 'Nothing' on parse error.
getOrientation :: Map ExifTag ExifValue -> Maybe ImageOrientation
getOrientation :: Map ExifTag ExifValue -> Maybe ImageOrientation
getOrientation Map ExifTag ExifValue
exifData = do
    ExifValue
rotationVal <- ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
orientation Map ExifTag ExifValue
exifData
    case ExifValue
rotationVal of
        ExifNumber Int
1 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just ImageOrientation
Normal
        ExifNumber Int
2 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just ImageOrientation
Mirror
        ExifNumber Int
3 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just (ImageOrientation -> Maybe ImageOrientation)
-> ImageOrientation -> Maybe ImageOrientation
forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
Rotation RotationDirection
HundredAndEighty
        ExifNumber Int
4 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just (ImageOrientation -> Maybe ImageOrientation)
-> ImageOrientation -> Maybe ImageOrientation
forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
MirrorRotation RotationDirection
HundredAndEighty
        ExifNumber Int
5 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just (ImageOrientation -> Maybe ImageOrientation)
-> ImageOrientation -> Maybe ImageOrientation
forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
MirrorRotation RotationDirection
MinusNinety
        ExifNumber Int
6 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just (ImageOrientation -> Maybe ImageOrientation)
-> ImageOrientation -> Maybe ImageOrientation
forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
Rotation RotationDirection
MinusNinety
        ExifNumber Int
7 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just (ImageOrientation -> Maybe ImageOrientation)
-> ImageOrientation -> Maybe ImageOrientation
forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
MirrorRotation RotationDirection
Ninety
        ExifNumber Int
8 -> ImageOrientation -> Maybe ImageOrientation
forall a. a -> Maybe a
Just (ImageOrientation -> Maybe ImageOrientation)
-> ImageOrientation -> Maybe ImageOrientation
forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
Rotation RotationDirection
Ninety
        ExifValue
_ -> Maybe ImageOrientation
forall a. Maybe a
Nothing

-- | Will return Just True if the flash was fired, Just False
-- if it was not, and Nothing if the file does not contain
-- the information.
wasFlashFired :: Map ExifTag ExifValue -> Maybe Bool
wasFlashFired :: Map ExifTag ExifValue -> Maybe Bool
wasFlashFired Map ExifTag ExifValue
exifData = ExifTag -> Map ExifTag ExifValue -> Maybe ExifValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
flash Map ExifTag ExifValue
exifData Maybe ExifValue -> (ExifValue -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ExifNumber Int
n -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    ExifValue
_ -> Maybe Bool
forall a. Maybe a
Nothing

-- $intro
--
-- 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.
--
-- Regarding the ExifTag type there is however a field of that type that may
-- interest you: 'prettyPrinter'. It's a function that'll format nicely an exif value
-- for that exif tag as a String.
-- For instance for the 'flash' ExifTag, it'll say whether the flash was
-- fired or not, if there was return light and so on.
--
-- Generally speaking, you start from a JPEG file, you can parse its exif tags as a 'Map' of
-- 'ExifTag' to 'ExifValue' using 'parseExif' or 'parseFileExif'.
-- You can enumerate the map or 'lookup' the tags that interest you.
--
-- There are also a couple of higher-level helpers like 'getOrientation',
-- 'getDateTimeOriginal', 'wasFlashFired' and 'getGpsLatitudeLongitude'.
--
-- When building on Windows if you have trouble with the @iconv@ library,
-- you may build without that dependency: @cabal install -f-iconv@.
-- That way you loose nice decoding of the EXIF User Comment though.