{-# LANGUAGE CPP #-}
module Codec.Picture.Tiff.Internal.Metadata
( extractTiffMetadata
, encodeTiffStringMetadata
, exifOffsetIfd
) where
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( mempty )
import Data.Foldable( foldMap )
import Control.Applicative( (<$>) )
#endif
import Data.Bits( unsafeShiftL, (.|.) )
import Data.Foldable( find )
import Data.List( sortBy )
import Data.Function( on )
import qualified Data.Foldable as F
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid( (<>) )
#endif
import Codec.Picture.Metadata( Metadatas )
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Codec.Picture.Metadata as Met
import qualified Data.Vector.Generic as V
import Codec.Picture.Tiff.Internal.Types
import Codec.Picture.Metadata( extractExifMetas )
import Codec.Picture.Metadata.Exif
exifOffsetIfd :: ImageFileDirectory
exifOffsetIfd :: ImageFileDirectory
exifOffsetIfd = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
TagExifOffset
, ifdCount :: Word32
ifdCount = Word32
1
, ifdType :: IfdType
ifdType = IfdType
TypeLong
, ifdOffset :: Word32
ifdOffset = Word32
0
, ifdExtended :: ExifData
ifdExtended = ExifData
ExifNone
}
typeOfData :: ExifData -> IfdType
typeOfData :: ExifData -> IfdType
typeOfData ExifData
d = case ExifData
d of
ExifData
ExifNone -> forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible - typeOfData : ExifNone"
ExifIFD [(ExifTag, ExifData)]
_exifs -> forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible - typeOfData : ExifIFD"
ExifLong Word32
_l -> IfdType
TypeLong
ExifLongs Vector Word32
_l -> IfdType
TypeLong
ExifShort Word16
_s -> IfdType
TypeShort
ExifShorts Vector Word16
_s -> IfdType
TypeShort
ExifString ByteString
_str -> IfdType
TypeAscii
ExifUndefined ByteString
_undef -> IfdType
TypeUndefined
ExifRational Word32
_r1 Word32
_r2 -> IfdType
TypeRational
ExifSignedRational Int32
_sr1 Int32
_sr2 -> IfdType
TypeSignedRational
makeIfd :: ExifTag -> ExifData -> ImageFileDirectory
makeIfd :: ExifTag -> ExifData -> ImageFileDirectory
makeIfd ExifTag
t (ExifShort Word16
v) = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeShort
, ifdCount :: Word32
ifdCount = Word32
1
, ifdOffset :: Word32
ifdOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
, ifdExtended :: ExifData
ifdExtended = ExifData
ExifNone
}
makeIfd ExifTag
t (ExifLong Word32
v) = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeLong
, ifdCount :: Word32
ifdCount = Word32
1
, ifdOffset :: Word32
ifdOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
, ifdExtended :: ExifData
ifdExtended = ExifData
ExifNone
}
makeIfd ExifTag
t d :: ExifData
d@(ExifShorts Vector Word16
v)
| Word32
size forall a. Eq a => a -> a -> Bool
== Word32
2 = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeShort
, ifdCount :: Word32
ifdCount = Word32
2
, ifdOffset :: Word32
ifdOffset = Word32
combined
, ifdExtended :: ExifData
ifdExtended = ExifData
ExifNone
}
| Bool
otherwise = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeShort
, ifdCount :: Word32
ifdCount = Word32
size
, ifdOffset :: Word32
ifdOffset = Word32
0
, ifdExtended :: ExifData
ifdExtended = ExifData
d
}
where
size :: Word32
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Vector Word16
v
at :: Int -> b
at Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Vector Word16
v forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.! Int
i
combined :: Word32
combined = (forall {b}. Num b => Int -> b
at Int
0 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16) forall a. Bits a => a -> a -> a
.|. forall {b}. Num b => Int -> b
at Int
1
makeIfd ExifTag
t d :: ExifData
d@(ExifLongs Vector Word32
v)
| Word32
size forall a. Eq a => a -> a -> Bool
== Word32
1 = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeLong
, ifdCount :: Word32
ifdCount = Word32
1
, ifdOffset :: Word32
ifdOffset = Vector Word32
v forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.! Int
0
, ifdExtended :: ExifData
ifdExtended = ExifData
ExifNone
}
| Bool
otherwise = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeLong
, ifdCount :: Word32
ifdCount = Word32
size
, ifdOffset :: Word32
ifdOffset = Word32
0
, ifdExtended :: ExifData
ifdExtended = ExifData
d
}
where size :: Word32
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Vector Word32
v
makeIfd ExifTag
t s :: ExifData
s@(ExifString ByteString
str) = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeAscii
, ifdCount :: Word32
ifdCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BC.length ByteString
str
, ifdOffset :: Word32
ifdOffset = Word32
0
, ifdExtended :: ExifData
ifdExtended = ExifData
s
}
makeIfd ExifTag
t s :: ExifData
s@(ExifUndefined ByteString
str)
| Word32
size forall a. Ord a => a -> a -> Bool
> Word32
4 = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeUndefined
, ifdCount :: Word32
ifdCount = Word32
size
, ifdOffset :: Word32
ifdOffset = Word32
0
, ifdExtended :: ExifData
ifdExtended = ExifData
s
}
| Bool
otherwise = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = IfdType
TypeUndefined
, ifdCount :: Word32
ifdCount = Word32
size
, ifdOffset :: Word32
ifdOffset = Word32
ofs
, ifdExtended :: ExifData
ifdExtended = ExifData
ExifNone
}
where
size :: Word32
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BC.length ByteString
str
at :: Int -> b
at Int
ix
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix forall a. Ord a => a -> a -> Bool
< Word32
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int -> Word8
B.index ByteString
str Int
ix forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4 forall a. Num a => a -> a -> a
- (Int
8 forall a. Num a => a -> a -> a
* Int
ix))
| Bool
otherwise = b
0
ofs :: Word32
ofs = forall {b}. Num b => Int -> b
at Int
0 forall a. Bits a => a -> a -> a
.|. forall {b}. Num b => Int -> b
at Int
1 forall a. Bits a => a -> a -> a
.|. forall {b}. Num b => Int -> b
at Int
2 forall a. Bits a => a -> a -> a
.|. forall {b}. Num b => Int -> b
at Int
3
makeIfd ExifTag
t ExifData
d = ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
t
, ifdType :: IfdType
ifdType = ExifData -> IfdType
typeOfData ExifData
d
, ifdCount :: Word32
ifdCount = Word32
1
, ifdOffset :: Word32
ifdOffset = Word32
0
, ifdExtended :: ExifData
ifdExtended = ExifData
d
}
encodeTiffStringMetadata :: Metadatas -> [ImageFileDirectory]
encodeTiffStringMetadata :: Metadatas -> [ImageFileDirectory]
encodeTiffStringMetadata Metadatas
metas = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ExifTag -> Word16
word16OfTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageFileDirectory -> ExifTag
ifdIdentifier) forall a b. (a -> b) -> a -> b
$ [ImageFileDirectory]
allTags where
keyStr :: ExifTag -> Keys [Char] -> f ImageFileDirectory
keyStr ExifTag
tag Keys [Char]
k = case forall a. Keys a -> Metadatas -> Maybe a
Met.lookup Keys [Char]
k Metadatas
metas of
Maybe [Char]
Nothing -> forall a. Monoid a => a
mempty
Just [Char]
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExifTag -> ExifData -> ImageFileDirectory
makeIfd ExifTag
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExifData
ExifString forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BC.pack [Char]
v
allTags :: [ImageFileDirectory]
allTags = [ImageFileDirectory]
copyright forall a. Semigroup a => a -> a -> a
<> [ImageFileDirectory]
artist forall a. Semigroup a => a -> a -> a
<> [ImageFileDirectory]
title forall a. Semigroup a => a -> a -> a
<> [ImageFileDirectory]
description forall a. Semigroup a => a -> a -> a
<> [ImageFileDirectory]
software forall a. Semigroup a => a -> a -> a
<> [ImageFileDirectory]
allPureExif
allPureExif :: [ImageFileDirectory]
allPureExif = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ExifTag -> ExifData -> ImageFileDirectory
makeIfd) forall a b. (a -> b) -> a -> b
$ Metadatas -> [(ExifTag, ExifData)]
extractExifMetas Metadatas
metas
copyright :: [ImageFileDirectory]
copyright = forall {f :: * -> *}.
(Monoid (f ImageFileDirectory), Applicative f) =>
ExifTag -> Keys [Char] -> f ImageFileDirectory
keyStr ExifTag
TagCopyright Keys [Char]
Met.Copyright
artist :: [ImageFileDirectory]
artist = forall {f :: * -> *}.
(Monoid (f ImageFileDirectory), Applicative f) =>
ExifTag -> Keys [Char] -> f ImageFileDirectory
keyStr ExifTag
TagArtist Keys [Char]
Met.Author
title :: [ImageFileDirectory]
title = forall {f :: * -> *}.
(Monoid (f ImageFileDirectory), Applicative f) =>
ExifTag -> Keys [Char] -> f ImageFileDirectory
keyStr ExifTag
TagDocumentName Keys [Char]
Met.Title
description :: [ImageFileDirectory]
description = forall {f :: * -> *}.
(Monoid (f ImageFileDirectory), Applicative f) =>
ExifTag -> Keys [Char] -> f ImageFileDirectory
keyStr ExifTag
TagImageDescription Keys [Char]
Met.Description
software :: [ImageFileDirectory]
software = forall {f :: * -> *}.
(Monoid (f ImageFileDirectory), Applicative f) =>
ExifTag -> Keys [Char] -> f ImageFileDirectory
keyStr ExifTag
TagSoftware Keys [Char]
Met.Software
extractTiffStringMetadata :: [ImageFileDirectory] -> Metadatas
= forall a.
(Show a, NFData a) =>
Keys a -> a -> Metadatas -> Metadatas
Met.insert Keys SourceFormat
Met.Format SourceFormat
Met.SourceTiff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImageFileDirectory -> Metadatas
go where
strMeta :: Keys [Char] -> ByteString -> Metadatas
strMeta Keys [Char]
k = forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton Keys [Char]
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BC.unpack
exif :: ImageFileDirectory -> Metadatas
exif ImageFileDirectory
ifd =
forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton (ExifTag -> Keys ExifData
Met.Exif forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
ifd) forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifData
ifdExtended ImageFileDirectory
ifd
inserter :: Metadatas -> (ExifTag, ExifData) -> Metadatas
inserter Metadatas
acc (ExifTag
k, ExifData
v) = forall a.
(Show a, NFData a) =>
Keys a -> a -> Metadatas -> Metadatas
Met.insert (ExifTag -> Keys ExifData
Met.Exif ExifTag
k) ExifData
v Metadatas
acc
exifShort :: ImageFileDirectory -> Metadatas
exifShort ImageFileDirectory
ifd =
forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton (ExifTag -> Keys ExifData
Met.Exif forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
ifd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> ExifData
ExifShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
ifd
go :: ImageFileDirectory -> Metadatas
go :: ImageFileDirectory -> Metadatas
go ImageFileDirectory
ifd = case (ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
ifd, ImageFileDirectory -> ExifData
ifdExtended ImageFileDirectory
ifd) of
(ExifTag
TagArtist, ExifString ByteString
v) -> Keys [Char] -> ByteString -> Metadatas
strMeta Keys [Char]
Met.Author ByteString
v
(ExifTag
TagBitsPerSample, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagColorMap, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagCompression, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagCopyright, ExifString ByteString
v) -> Keys [Char] -> ByteString -> Metadatas
strMeta Keys [Char]
Met.Copyright ByteString
v
(ExifTag
TagDocumentName, ExifString ByteString
v) -> Keys [Char] -> ByteString -> Metadatas
strMeta Keys [Char]
Met.Title ByteString
v
(ExifTag
TagExifOffset, ExifIFD [(ExifTag, ExifData)]
lst) -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Metadatas -> (ExifTag, ExifData) -> Metadatas
inserter forall a. Monoid a => a
mempty [(ExifTag, ExifData)]
lst
(ExifTag
TagImageDescription, ExifString ByteString
v) -> Keys [Char] -> ByteString -> Metadatas
strMeta Keys [Char]
Met.Description ByteString
v
(ExifTag
TagImageLength, ExifData
_) -> forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton Keys Word
Met.Height forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
ifd
(ExifTag
TagImageWidth, ExifData
_) -> forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton Keys Word
Met.Width forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
ifd
(ExifTag
TagJPEGACTables, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGDCTables, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGInterchangeFormat, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGInterchangeFormatLength, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGLosslessPredictors, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGPointTransforms, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGQTables, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJPEGRestartInterval, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagJpegProc, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagModel, ExifData
v) -> forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton (ExifTag -> Keys ExifData
Met.Exif ExifTag
TagModel) ExifData
v
(ExifTag
TagMake, ExifData
v) -> forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
Met.singleton (ExifTag -> Keys ExifData
Met.Exif ExifTag
TagMake) ExifData
v
(ExifTag
TagOrientation, ExifData
_) -> ImageFileDirectory -> Metadatas
exifShort ImageFileDirectory
ifd
(ExifTag
TagResolutionUnit, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagRowPerStrip, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagSamplesPerPixel, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagSoftware, ExifString ByteString
v) -> Keys [Char] -> ByteString -> Metadatas
strMeta Keys [Char]
Met.Software ByteString
v
(ExifTag
TagStripByteCounts, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagStripOffsets, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagTileByteCount, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagTileLength, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagTileOffset, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagTileWidth, ExifData
_) -> forall a. Monoid a => a
mempty
(TagUnknown Word16
_, ExifData
_) -> ImageFileDirectory -> Metadatas
exif ImageFileDirectory
ifd
(ExifTag
TagXResolution, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagYCbCrCoeff, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagYCbCrPositioning, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagYCbCrSubsampling, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag
TagYResolution, ExifData
_) -> forall a. Monoid a => a
mempty
(ExifTag, ExifData)
_ -> forall a. Monoid a => a
mempty
byTag :: ExifTag -> ImageFileDirectory -> Bool
byTag :: ExifTag -> ImageFileDirectory -> Bool
byTag ExifTag
t ImageFileDirectory
ifd = ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
ifd forall a. Eq a => a -> a -> Bool
== ExifTag
t
data TiffResolutionUnit
= ResolutionUnitUnknown
| ResolutionUnitInch
| ResolutionUnitCentimeter
unitOfIfd :: ImageFileDirectory -> TiffResolutionUnit
unitOfIfd :: ImageFileDirectory -> TiffResolutionUnit
unitOfIfd ImageFileDirectory
ifd = case (ImageFileDirectory -> IfdType
ifdType ImageFileDirectory
ifd, ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
ifd) of
(IfdType
TypeShort, Word32
1) -> TiffResolutionUnit
ResolutionUnitUnknown
(IfdType
TypeShort, Word32
2) -> TiffResolutionUnit
ResolutionUnitInch
(IfdType
TypeShort, Word32
3) -> TiffResolutionUnit
ResolutionUnitCentimeter
(IfdType, Word32)
_ -> TiffResolutionUnit
ResolutionUnitUnknown
extractTiffDpiMetadata :: [ImageFileDirectory] -> Metadatas
[ImageFileDirectory]
lst = Metadatas
go where
go :: Metadatas
go = case ImageFileDirectory -> TiffResolutionUnit
unitOfIfd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ExifTag -> ImageFileDirectory -> Bool
byTag ExifTag
TagResolutionUnit) [ImageFileDirectory]
lst of
Maybe TiffResolutionUnit
Nothing -> forall a. Monoid a => a
mempty
Just TiffResolutionUnit
ResolutionUnitUnknown -> forall a. Monoid a => a
mempty
Just TiffResolutionUnit
ResolutionUnitCentimeter -> forall {b}. Num b => (b -> Word) -> Metadatas -> Metadatas
findDpis Word -> Word
Met.dotsPerCentiMeterToDotPerInch forall a. Monoid a => a
mempty
Just TiffResolutionUnit
ResolutionUnitInch -> forall {b}. Num b => (b -> Word) -> Metadatas -> Metadatas
findDpis forall a. a -> a
id forall a. Monoid a => a
mempty
findDpis :: (b -> Word) -> Metadatas -> Metadatas
findDpis b -> Word
toDpi =
forall {a} {b}.
(Show a, NFData a, Num b) =>
Keys a -> ExifTag -> (b -> a) -> Metadatas -> Metadatas
findDpi Keys Word
Met.DpiX ExifTag
TagXResolution b -> Word
toDpi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}.
(Show a, NFData a, Num b) =>
Keys a -> ExifTag -> (b -> a) -> Metadatas -> Metadatas
findDpi Keys Word
Met.DpiY ExifTag
TagYResolution b -> Word
toDpi
findDpi :: Keys a -> ExifTag -> (b -> a) -> Metadatas -> Metadatas
findDpi Keys a
k ExifTag
tag b -> a
toDpi Metadatas
metas = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ExifTag -> ImageFileDirectory -> Bool
byTag ExifTag
tag) [ImageFileDirectory]
lst of
Maybe ImageFileDirectory
Nothing -> Metadatas
metas
Just ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifRational Word32
num Word32
den } ->
forall a.
(Show a, NFData a) =>
Keys a -> a -> Metadatas -> Metadatas
Met.insert Keys a
k (b -> a
toDpi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
num forall a. Integral a => a -> a -> a
`div` Word32
den) Metadatas
metas
Just ImageFileDirectory
_ -> Metadatas
metas
extractTiffMetadata :: [ImageFileDirectory] -> Metadatas
[ImageFileDirectory]
lst = [ImageFileDirectory] -> Metadatas
extractTiffDpiMetadata [ImageFileDirectory]
lst forall a. Semigroup a => a -> a -> a
<> [ImageFileDirectory] -> Metadatas
extractTiffStringMetadata [ImageFileDirectory]
lst