{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Graphics.HsExif (
parseFileExif,
parseExif,
readExifDateTime,
getDateTimeOriginal,
getOrientation,
ImageOrientation(..),
RotationDirection(..),
getGpsLatitudeLongitude,
wasFlashFired,
formatAsFloatingPoint,
getGpsDateTime,
parseGpsTime,
ExifValue(..),
exposureTime,
fnumber,
isoSpeedRatings,
dateTimeOriginal,
shutterSpeedValue,
apertureValue,
brightnessValue,
exposureBiasValue,
maxApertureValue,
flash,
focalLength,
userComment,
orientation,
make,
model,
software,
copyright,
digitalZoomRatio,
focalLengthIn35mmFilm,
artist,
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,
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,
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 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)
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
parseFileExif :: FilePath -> IO (Either String (Map ExifTag ExifValue))
parseFileExif :: [Char] -> IO (Either [Char] (Map ExifTag ExifValue))
parseFileExif [Char]
filename = forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
filename IOMode
ReadMode ((forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] (Map ExifTag ExifValue)
parseExif) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO ByteString
B.hGetContents)
parseExif :: B.ByteString -> Either String (Map ExifTag ExifValue)
parseExif :: ByteString -> Either [Char] (Map ExifTag ExifValue)
parseExif = forall a. Get a -> ByteString -> Either [Char] a
runEitherGet Get (Map ExifTag ExifValue)
getExif
getExif :: Get (Map ExifTag ExifValue)
getExif :: Get (Map ExifTag ExifValue)
getExif = do
(Word16, Word16)
firstBytes <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
Bool
ftypheic <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ do
Int -> Get ()
skip Int
4
ByteString
ftyp <- Int -> Get ByteString
getByteString Int
4
Int -> Get ()
skip Int
8
ByteString
mif <- Int -> Get ByteString
getByteString Int
4
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString
ftyp forall a. Eq a => a -> a -> Bool
== ByteString
"ftyp" Bool -> Bool -> Bool
&& ByteString
mif forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"mif1", ByteString
"msf1"]
case (Word16, Word16)
firstBytes of
(Word16
0xffd8,Word16
_ ) -> Get Word16
getWord16be 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
(Word16
0x4949,Word16
0x2A00) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff
(Word16
0x4949,Word16
0x524F) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff
(Word16
0x4949,Word16
0x5500) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockTiff
(Word16
0x4655,Word16
0x4A49) -> Get (Map ExifTag ExifValue)
findAndParseExifBlockFuji
(Word16, Word16)
_ -> if Bool
ftypheic
then Get (Map ExifTag ExifValue)
findAndParseExifBlockHEIC
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Year
toInteger 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right Map ExifTag ExifValue
exif -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ExifTag ExifValue
exif
Left Int
bytesReadByTry -> Int -> Get ()
skip (Int
dataSize forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- Int
bytesReadByTry) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG
Word16
0xffda -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No EXIF in JPEG"
Word16
_ -> Int -> Get ()
skip (Int
dataSizeforall a. Num a => a -> a -> a
-Int
2) 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
header forall a. Eq a => a -> a -> Bool
== ByteString
"FUJIFILMCCD-RAW " Bool -> Bool -> Bool
&& ByteString
version forall a. Eq a => a -> a -> Bool
== ByteString
"0201") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Incorrect RAF header"
Int -> Get ()
skip forall a b. (a -> b) -> a -> b
$
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
jpegOffset
forall a. Num a => a -> a -> a
- Int
16
forall a. Num a => a -> a -> a
- Int
4
forall a. Num a => a -> a -> a
- Int
64
forall a. Num a => a -> a -> a
- Int
4
forall a. Num a => a -> a -> a
+ Int
2
Get (Map ExifTag ExifValue)
findAndParseExifBlockJPEG
findAndParseExifBlockHEIC :: Get (Map ExifTag ExifValue)
findAndParseExifBlockHEIC :: Get (Map ExifTag ExifValue)
findAndParseExifBlockHEIC = do
(ByteString
e, Year
nul, ByteString
aligned) <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
4 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Integral a => a -> Year
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getByteString Int
2
if ByteString
e forall a. Eq a => a -> a -> Bool
== ByteString
"Exif" Bool -> Bool -> Bool
&& Year
nul forall a. Eq a => a -> a -> Bool
== Year
0 Bool -> Bool -> Bool
&& ByteString
aligned forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"MM", ByteString
"II"]
then Int -> Get ()
skip Int
6 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Map ExifTag ExifValue)
parseTiff
else Int -> Get ()
skip Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Map ExifTag ExifValue)
findAndParseExifBlockHEIC
data ByteAlign = Intel | Motorola deriving (ByteAlign -> ByteAlign -> Bool
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
tryParseExifBlock :: Get (Either Int (Map ExifTag ExifValue))
tryParseExifBlock :: Get (Either Int (Map ExifTag ExifValue))
tryParseExifBlock = do
ByteString
header <- Int -> Get ByteString
getByteString Int
4
Year
nul <- forall a. Integral a => a -> Year
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
if ByteString
header forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
Char8.pack [Char]
"Exif" Bool -> Bool -> Bool
&& Year
nul forall a. Eq a => a -> a -> Bool
== Year
0
then forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Map ExifTag ExifValue)
parseTiff
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Int
6)
parseTiff :: Get (Map ExifTag ExifValue)
parseTiff :: Get (Map ExifTag ExifValue)
parseTiff = do
(ByteAlign
byteAlign, Int
ifdOffset) <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ExifTag, ExifValue)]
tags
parseTiffHeader :: Get (ByteAlign, Int)
= do
[Char]
byteAlignV <- ByteString -> [Char]
Char8.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
2
ByteAlign
byteAlign <- case [Char]
byteAlignV of
[Char]
"II" -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteAlign
Intel
[Char]
"MM" -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteAlign
Motorola
[Char]
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown byte alignment: " forall a. [a] -> [a] -> [a]
++ [Char]
byteAlignV
Year
alignControl <- forall a. Integral a => a -> Year
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word16
getWord16 ByteAlign
byteAlign
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Year
alignControl forall a. Eq a => a -> a -> Bool
== Year
0x2a Bool -> Bool -> Bool
|| (ByteAlign
byteAlign forall a. Eq a => a -> a -> Bool
== ByteAlign
Intel Bool -> Bool -> Bool
&& (Year
alignControl forall a. Eq a => a -> a -> Bool
== Year
0x55 Bool -> Bool -> Bool
|| Year
alignControl forall a. Eq a => a -> a -> Bool
== Year
0x4f52)))
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"exif byte alignment mismatch"
Int
ifdOffset <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Year
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteAlign
byteAlign, Int
ifdOffset)
parseIfd :: ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)]
parseIfd :: ByteAlign -> TagLocation -> Int -> Get [(ExifTag, ExifValue)]
parseIfd ByteAlign
byteAlign TagLocation
ifdId Int
offset = do
[IfEntry]
entries <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ do
Int -> Get ()
skip Int
offset
Int
dirEntriesCount <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word16
getWord16 ByteAlign
byteAlign
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
dirEntriesCount (ByteAlign -> TagLocation -> Get IfEntry
parseIfEntry ByteAlign
byteAlign TagLocation
ifdId)
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
entryTags :: ByteAlign -> IfEntry -> Get [(ExifTag, ExifValue)]
entryTags :: ByteAlign -> IfEntry -> Get [(ExifTag, ExifValue)]
entryTags ByteAlign
_ (Tag ExifTag
tag Get ExifValue
parseValue) = Get ExifValue
parseValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ExifValue
value -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ExifTag
tag, ExifValue
value)]
entryTags ByteAlign
byteAlign (SubIFD TagLocation
ifdId Int
offset) = 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
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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (TagLocation
ifdId, Word16
tagNumber) of
(TagLocation
IFD0, Word16
0x8769) -> TagLocation -> Int -> IfEntry
SubIFD TagLocation
ExifSubIFD (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
content)
(TagLocation
IFD0, Word16
0x8825) -> TagLocation -> Int -> IfEntry
SubIFD TagLocation
GpsSubIFD (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 = forall a. a -> Maybe a -> a
fromMaybe (TagLocation
-> Maybe [Char] -> Word16 -> (ExifValue -> Text) -> ExifTag
ExifTag TagLocation
l forall a. Maybe a
Nothing Word16
v forall a. Show a => a -> Text
showT) forall a b. (a -> b) -> a -> b
$ 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 [Char]
_ Word16
v2 ExifValue -> Text
_) = TagLocation
l1 forall a. Eq a => a -> a -> Bool
== TagLocation
l2 Bool -> Bool -> Bool
&& Word16
v1 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 :: forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ByteAlign -> Get a
decoder ByteAlign
byteAlign Int
components = [Int] -> ExifValue
ExifNumberList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. Int -> Get a -> Get [a]
count Int
components (ByteAlign -> Get a
decoder ByteAlign
byteAlign)
decodeTextByteString :: BS.ByteString -> String
decodeTextByteString :: ByteString -> [Char]
decodeTextByteString ByteString
bs = Word8 -> Char
w2c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8]
strippedWords
where
strippedWords :: [Word8]
strippedWords = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
bsWords) Bool -> Bool -> Bool
&& forall a. [a] -> a
last [Word8]
bsWords forall a. Eq a => a -> a -> Bool
== Word8
0
then forall a. [a] -> [a]
init [Word8]
bsWords
else [Word8]
bsWords
bsWords :: [Word8]
bsWords = ByteString -> [Word8]
BS.unpack ByteString
bs
unsignedByteValueHandler :: ValueHandler
unsignedByteValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
1,
dataLength :: Int
dataLength = Int
1,
readSingle :: ByteAlign -> Get ExifValue
readSingle = \ByteAlign
_ -> Int -> ExifValue
ExifNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8,
readMany :: ByteAlign -> Int -> Get ExifValue
readMany = forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Get Word8
getWord8
}
asciiStringValueHandler :: ValueHandler
asciiStringValueHandler = 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 -> [Char] -> ExifValue
ExifText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
decodeTextByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
components
}
unsignedShortValueHandler :: ValueHandler
unsignedShortValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
3,
dataLength :: Int
dataLength = Int
2,
readSingle :: ByteAlign -> Get ExifValue
readSingle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ExifValue
ExifNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word16
getWord16,
readMany :: ByteAlign -> Int -> Get ExifValue
readMany = forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ByteAlign -> Get Word16
getWord16
}
unsignedLongValueHandler :: ValueHandler
unsignedLongValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
4,
dataLength :: Int
dataLength = Int
4,
readSingle :: ByteAlign -> Get ExifValue
readSingle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ExifValue
ExifNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word32
getWord32,
readMany :: ByteAlign -> Int -> Get ExifValue
readMany = forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList ByteAlign -> Get Word32
getWord32
}
readRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents :: forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents Int -> Int -> a
c ByteAlign
byteAlign = do
Int
numerator <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
Int
denominator <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> a
c Int
numerator Int
denominator
unsignedRationalValueHandler :: ValueHandler
unsignedRationalValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
5,
dataLength :: Int
dataLength = Int
8,
readSingle :: ByteAlign -> Get ExifValue
readSingle = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get a -> Get [a]
count Int
components (forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readRationalContents (,) ByteAlign
byteAlign)
}
signedByteValueHandler :: ValueHandler
signedByteValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
6,
dataLength :: Int
dataLength = Int
1,
readSingle :: ByteAlign -> Get ExifValue
readSingle = \ByteAlign
_ -> Int -> ExifValue
ExifNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
signedInt8ToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8,
readMany :: ByteAlign -> Int -> Get ExifValue
readMany = forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int
signedInt8ToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const Get Word8
getWord8)
}
undefinedValueHandler :: ValueHandler
undefinedValueHandler = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
components
}
signedShortValueHandler :: ValueHandler
signedShortValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
8,
dataLength :: Int
dataLength = Int
2,
readSingle :: ByteAlign -> Get ExifValue
readSingle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ExifValue
ExifNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
signedInt16ToInt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word16
getWord16,
readMany :: ByteAlign -> Int -> Get ExifValue
readMany = forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Int
signedInt16ToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word16
getWord16)
}
signedLongValueHandler :: ValueHandler
signedLongValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
9,
dataLength :: Int
dataLength = Int
4,
readSingle :: ByteAlign -> Get ExifValue
readSingle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ExifValue
ExifNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
signedInt32ToInt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word32
getWord32,
readMany :: ByteAlign -> Int -> Get ExifValue
readMany = forall a.
Integral a =>
(ByteAlign -> Get a) -> ByteAlign -> Int -> Get ExifValue
readNumberList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int
signedInt32ToInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteAlign -> Get Word32
getWord32)
}
readSignedRationalContents :: (Int -> Int -> a) -> ByteAlign -> Get a
readSignedRationalContents :: forall a. (Int -> Int -> a) -> ByteAlign -> Get a
readSignedRationalContents Int -> Int -> a
c ByteAlign
byteAlign = do
Int
numerator <- Word32 -> Int
signedInt32ToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
Int
denominator <- Word32 -> Int
signedInt32ToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteAlign -> Get Word32
getWord32 ByteAlign
byteAlign
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> a
c Int
numerator Int
denominator
signedRationalValueHandler :: ValueHandler
signedRationalValueHandler = ValueHandler
{
dataTypeId :: Word16
dataTypeId = Word16
10,
dataLength :: Int
dataLength = Int
8,
readSingle :: ByteAlign -> Get ExifValue
readSingle = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. Int -> Get a -> Get [a]
count Int
components (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteAlign -> ValueHandler -> Int -> ByteString -> ExifValue
parseInline ByteAlign
byteAlign ValueHandler
handler Int
amount (Put -> ByteString
runPut 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Int -> ExifValue
ExifUnknown Word16
format Int
amount (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
payload)
where
isInline :: ValueHandler -> Bool
isInline ValueHandler
handler = ValueHandler -> Int
dataLength ValueHandler
handler forall a. Num a => a -> a -> a
* Int
amount forall a. Ord a => a -> a -> Bool
<= Int
4
getHandler :: Word16 -> Maybe ValueHandler
getHandler :: Word16 -> Maybe ValueHandler
getHandler Word16
typeId = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Word16
typeId) 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 =
forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ 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
forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ do
Int -> Get ()
skip (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset)
let bsLength :: Int
bsLength = Int
amount forall a. Num a => a -> a -> a
* ValueHandler -> Int
dataLength ValueHandler
handler
ByteString
bytestring <- Int64 -> Get ByteString
getLazyByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLength)
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w :: Int32)
signedInt16ToInt :: Word16 -> Int
signedInt16ToInt :: Word16 -> Int
signedInt16ToInt Word16
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w :: Int16)
signedInt8ToInt :: Word8 -> Int
signedInt8ToInt :: Word8 -> Int
signedInt8ToInt Word8
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w :: Int8)
readExifDateTime :: String -> Maybe LocalTime
readExifDateTime :: [Char] -> Maybe LocalTime
readExifDateTime [Char]
dateStr = forall a. Get a -> ByteString -> Maybe a
runMaybeGet Get LocalTime
getExifDateTime forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) [Char]
dateStr
getExifDateTime :: Get LocalTime
getExifDateTime :: Get LocalTime
getExifDateTime = do
Year
year <- forall a. Read a => Int -> Get a
readDigit Int
4
Int
month <- Char -> Get Char
getCharValue Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Read a => Int -> Get a
readDigit Int
2
Int
day <- Char -> Get Char
getCharValue Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Read a => Int -> Get a
readDigit Int
2
Int
hour <- Char -> Get Char
getCharValue Char
' ' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Read a => Int -> Get a
readDigit Int
2
Int
minute <- Char -> Get Char
getCharValue Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Read a => Int -> Get a
readDigit Int
2
Pico
second <- Char -> Get Char
getCharValue Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Read a => Int -> Get a
readDigit Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime (Year -> Int -> Int -> Day
fromGregorian Year
year Int
month Int
day) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
hour Int
minute Pico
second)
getDateTimeOriginal :: Map ExifTag ExifValue -> Maybe LocalTime
getDateTimeOriginal :: Map ExifTag ExifValue -> Maybe LocalTime
getDateTimeOriginal Map ExifTag ExifValue
exifData = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
dateTimeOriginal Map ExifTag ExifValue
exifData forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe LocalTime
readExifDateTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
data RotationDirection = MinusNinety
| Ninety
| HundredAndEighty
deriving (Int -> RotationDirection -> ShowS
[RotationDirection] -> ShowS
RotationDirection -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RotationDirection] -> ShowS
$cshowList :: [RotationDirection] -> ShowS
show :: RotationDirection -> [Char]
$cshow :: RotationDirection -> [Char]
showsPrec :: Int -> RotationDirection -> ShowS
$cshowsPrec :: Int -> RotationDirection -> ShowS
Show, RotationDirection -> RotationDirection -> Bool
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 -> ShowS
[ImageOrientation] -> ShowS
ImageOrientation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ImageOrientation] -> ShowS
$cshowList :: [ImageOrientation] -> ShowS
show :: ImageOrientation -> [Char]
$cshow :: ImageOrientation -> [Char]
showsPrec :: Int -> ImageOrientation -> ShowS
$cshowsPrec :: Int -> ImageOrientation -> ShowS
Show, ImageOrientation -> ImageOrientation -> Bool
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)
getOrientation :: Map ExifTag ExifValue -> Maybe ImageOrientation
getOrientation :: Map ExifTag ExifValue -> Maybe ImageOrientation
getOrientation Map ExifTag ExifValue
exifData = do
ExifValue
rotationVal <- 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 -> forall a. a -> Maybe a
Just ImageOrientation
Normal
ExifNumber Int
2 -> forall a. a -> Maybe a
Just ImageOrientation
Mirror
ExifNumber Int
3 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
Rotation RotationDirection
HundredAndEighty
ExifNumber Int
4 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
MirrorRotation RotationDirection
HundredAndEighty
ExifNumber Int
5 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
MirrorRotation RotationDirection
MinusNinety
ExifNumber Int
6 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
Rotation RotationDirection
MinusNinety
ExifNumber Int
7 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
MirrorRotation RotationDirection
Ninety
ExifNumber Int
8 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RotationDirection -> ImageOrientation
Rotation RotationDirection
Ninety
ExifValue
_ -> forall a. Maybe a
Nothing
wasFlashFired :: Map ExifTag ExifValue -> Maybe Bool
wasFlashFired :: Map ExifTag ExifValue -> Maybe Bool
wasFlashFired Map ExifTag ExifValue
exifData = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExifTag
flash Map ExifTag ExifValue
exifData forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ExifNumber Int
n -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
n forall a. Bits a => a -> a -> a
.&. Int
1 forall a. Eq a => a -> a -> Bool
/= Int
0
ExifValue
_ -> forall a. Maybe a
Nothing