    {-# 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 = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
      { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    TagExifOffset
      , ifdCount :: Word32
    ifdCount = 1
      , ifdType :: IfdType
    ifdType = IfdType
    TypeLong
      , ifdOffset :: Word32
    ifdOffset = 0
      , ifdExtended :: ExifData
    ifdExtended = ExifData
    ExifNone
      }

    typeOfData :: ExifData -> IfdType
    typeOfData :: ExifData -> IfdType
    typeOfData d :: ExifData
    d = case ExifData
    d of
      ExifNone -> [Char] -> IfdType
    forall a. HasCallStack => [Char] -> a
    error "Impossible - typeOfData : ExifNone"
      ExifIFD _exifs :: [(ExifTag, ExifData)]
    _exifs -> [Char] -> IfdType
    forall a. HasCallStack => [Char] -> a
    error "Impossible - typeOfData : ExifIFD"
      ExifLong _l :: Word32
    _l -> IfdType
    TypeLong
      ExifLongs _l :: Vector Word32
    _l -> IfdType
    TypeLong
      ExifShort _s :: Word16
    _s -> IfdType
    TypeShort
      ExifShorts _s :: Vector Word16
    _s -> IfdType
    TypeShort
      ExifString _str :: ByteString
    _str -> IfdType
    TypeAscii
      ExifUndefined _undef :: ByteString
    _undef -> IfdType
    TypeUndefined
      ExifRational _r1 :: Word32
    _r1 _r2 :: Word32
    _r2 -> IfdType
    TypeRational
      ExifSignedRational _sr1 :: Int32
    _sr1 _sr2 :: Int32
    _sr2 -> IfdType
    TypeSignedRational

    makeIfd :: ExifTag -> ExifData -> ImageFileDirectory
    makeIfd :: ExifTag -> ExifData -> ImageFileDirectory
    makeIfd t :: ExifTag
    t (ExifShort v :: Word16
    v) = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
      { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
      , ifdType :: IfdType
    ifdType = IfdType
    TypeShort
      , ifdCount :: Word32
    ifdCount = 1
      , ifdOffset :: Word32
    ifdOffset = Word16 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    v Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` 16
      , ifdExtended :: ExifData
    ifdExtended = ExifData
    ExifNone
      }
    makeIfd t :: ExifTag
    t (ExifLong v :: Word32
    v) = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
      { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
      , ifdType :: IfdType
    ifdType = IfdType
    TypeLong
      , ifdCount :: Word32
    ifdCount = 1
      , ifdOffset :: Word32
    ifdOffset = Word32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    v
      , ifdExtended :: ExifData
    ifdExtended = ExifData
    ExifNone
      }
    makeIfd t :: ExifTag
    t d :: ExifData
    d@(ExifShorts v :: Vector Word16
    v)
      | Word32
    size Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 2 = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
        { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
        , ifdType :: IfdType
    ifdType = IfdType
    TypeShort
        , ifdCount :: Word32
    ifdCount = 2
        , ifdOffset :: Word32
    ifdOffset = Word32
    combined
        , ifdExtended :: ExifData
    ifdExtended = ExifData
    ExifNone
        }
      | Bool
    otherwise = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
        { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
        , ifdType :: IfdType
    ifdType = IfdType
    TypeShort
        , ifdCount :: Word32
    ifdCount = Word32
    size
        , ifdOffset :: Word32
    ifdOffset = 0
        , ifdExtended :: ExifData
    ifdExtended = ExifData
    d
        }
      where
        size :: Word32
    size = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Vector Word16 -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    F.length Vector Word16
    v
        at :: Int -> b
    at i :: Int
    i = Word16 -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> b) -> Word16 -> b
    forall a b. (a -> b) -> a -> b
    $ Vector Word16
    v Vector Word16 -> Int -> Word16
    forall (v :: * -> *) a. Vector v a => v a -> Int -> a
    V.! Int
    i
        combined :: Word32
    combined = (Int -> Word32
    forall b. Num b => Int -> b
    at 0  Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` 16) Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. Int -> Word32
    forall b. Num b => Int -> b
    at 1
    makeIfd t :: ExifTag
    t d :: ExifData
    d@(ExifLongs v :: Vector Word32
    v)
      | Word32
    size Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
        { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
        , ifdType :: IfdType
    ifdType = IfdType
    TypeLong
        , ifdCount :: Word32
    ifdCount = 1
        , ifdOffset :: Word32
    ifdOffset = Vector Word32
    v Vector Word32 -> Int -> Word32
    forall (v :: * -> *) a. Vector v a => v a -> Int -> a
    V.! 0
        , ifdExtended :: ExifData
    ifdExtended = ExifData
    ExifNone
        }
      | Bool
    otherwise = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
        { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
        , ifdType :: IfdType
    ifdType = IfdType
    TypeLong
        , ifdCount :: Word32
    ifdCount = Word32
    size
        , ifdOffset :: Word32
    ifdOffset = 0
        , ifdExtended :: ExifData
    ifdExtended = ExifData
    d
        }
      where size :: Word32
    size = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Vector Word32 -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    F.length Vector Word32
    v
    makeIfd t :: ExifTag
    t s :: ExifData
    s@(ExifString str :: ByteString
    str) = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
        { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
        , ifdType :: IfdType
    ifdType = IfdType
    TypeAscii
        , ifdCount :: Word32
    ifdCount = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    BC.length ByteString
    str
        , ifdOffset :: Word32
    ifdOffset = 0
        , ifdExtended :: ExifData
    ifdExtended = ExifData
    s
        }
    makeIfd t :: ExifTag
    t s :: ExifData
    s@(ExifUndefined str :: ByteString
    str)
      | Word32
    size Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > 4 = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
        { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
        , ifdType :: IfdType
    ifdType = IfdType
    TypeUndefined
        , ifdCount :: Word32
    ifdCount = Word32
    size
        , ifdOffset :: Word32
    ifdOffset = 0
        , ifdExtended :: ExifData
    ifdExtended = ExifData
    s
        }
      | Bool
    otherwise = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    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 = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    BC.length ByteString
    str
        at :: Int -> p
    at ix :: Int
    ix
          | Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    ix Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    size = Word8 -> p
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> p) -> Word8 -> p
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int -> Word8
    B.index ByteString
    str Int
    ix Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` (4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    ix))
          | Bool
    otherwise = 0
        ofs :: Word32
    ofs = Int -> Word32
    forall b. Num b => Int -> b
    at 0 Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. Int -> Word32
    forall b. Num b => Int -> b
    at 1 Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. Int -> Word32
    forall b. Num b => Int -> b
    at 2 Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. Int -> Word32
    forall b. Num b => Int -> b
    at 3
    makeIfd t :: ExifTag
    t d :: ExifData
    d = $WImageFileDirectory :: ExifTag
    -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
    ImageFileDirectory
      { ifdIdentifier :: ExifTag
    ifdIdentifier = ExifTag
    t
      , ifdType :: IfdType
    ifdType = ExifData -> IfdType
    typeOfData ExifData
    d
      , ifdCount :: Word32
    ifdCount = 1
      , ifdOffset :: Word32
    ifdOffset = 0
      , ifdExtended :: ExifData
    ifdExtended = ExifData
    d
      }

    encodeTiffStringMetadata :: Metadatas -> [ImageFileDirectory]
    encodeTiffStringMetadata :: Metadatas -> [ImageFileDirectory]
    encodeTiffStringMetadata metas :: Metadatas
    metas = (ImageFileDirectory -> ImageFileDirectory -> Ordering)
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Word16 -> Word16 -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Word16 -> Word16 -> Ordering)
    -> (ImageFileDirectory -> Word16)
    -> ImageFileDirectory
    -> ImageFileDirectory
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` ExifTag -> Word16
    word16OfTag (ExifTag -> Word16)
    -> (ImageFileDirectory -> ExifTag) -> ImageFileDirectory -> Word16
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImageFileDirectory -> ExifTag
    ifdIdentifier) ([ImageFileDirectory] -> [ImageFileDirectory])
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a b. (a -> b) -> a -> b
    $ [ImageFileDirectory]
    allTags where
      keyStr :: ExifTag -> Keys [Char] -> f ImageFileDirectory
    keyStr tag :: ExifTag
    tag k :: Keys [Char]
    k = case Keys [Char] -> Metadatas -> Maybe [Char]
    forall a. Keys a -> Metadatas -> Maybe a
    Met.lookup Keys [Char]
    k Metadatas
    metas of
        Nothing -> f ImageFileDirectory
    forall a. Monoid a => a
    mempty
        Just v :: [Char]
    v -> ImageFileDirectory -> f ImageFileDirectory
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ImageFileDirectory -> f ImageFileDirectory)
    -> (ByteString -> ImageFileDirectory)
    -> ByteString
    -> f ImageFileDirectory
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExifTag -> ExifData -> ImageFileDirectory
    makeIfd ExifTag
    tag (ExifData -> ImageFileDirectory)
    -> (ByteString -> ExifData) -> ByteString -> ImageFileDirectory
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ExifData
    ExifString (ByteString -> f ImageFileDirectory)
    -> ByteString -> f ImageFileDirectory
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ByteString
    BC.pack [Char]
    v
      allTags :: [ImageFileDirectory]
    allTags = [ImageFileDirectory]
    copyright [ImageFileDirectory]
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. Semigroup a => a -> a -> a
    <> [ImageFileDirectory]
    artist [ImageFileDirectory]
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. Semigroup a => a -> a -> a
    <> [ImageFileDirectory]
    title [ImageFileDirectory]
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. Semigroup a => a -> a -> a
    <> [ImageFileDirectory]
    description [ImageFileDirectory]
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. Semigroup a => a -> a -> a
    <> [ImageFileDirectory]
    software [ImageFileDirectory]
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. Semigroup a => a -> a -> a
    <> [ImageFileDirectory]
    allPureExif

      allPureExif :: [ImageFileDirectory]
    allPureExif = ((ExifTag, ExifData) -> ImageFileDirectory)
    -> [(ExifTag, ExifData)] -> [ImageFileDirectory]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((ExifTag -> ExifData -> ImageFileDirectory)
    -> (ExifTag, ExifData) -> ImageFileDirectory
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ExifTag -> ExifData -> ImageFileDirectory
    makeIfd) ([(ExifTag, ExifData)] -> [ImageFileDirectory])
    -> [(ExifTag, ExifData)] -> [ImageFileDirectory]
    forall a b. (a -> b) -> a -> b
    $ Metadatas -> [(ExifTag, ExifData)]
    extractExifMetas Metadatas
    metas

      copyright :: [ImageFileDirectory]
    copyright = ExifTag -> Keys [Char] -> [ImageFileDirectory]
    forall (f :: * -> *).
    (Monoid (f ImageFileDirectory), Applicative f) =>
    ExifTag -> Keys [Char] -> f ImageFileDirectory
    keyStr ExifTag
    TagCopyright Keys [Char]
    Met.Copyright
      artist :: [ImageFileDirectory]
    artist = ExifTag -> Keys [Char] -> [ImageFileDirectory]
    forall (f :: * -> *).
    (Monoid (f ImageFileDirectory), Applicative f) =>
    ExifTag -> Keys [Char] -> f ImageFileDirectory
    keyStr ExifTag
    TagArtist Keys [Char]
    Met.Author
      title :: [ImageFileDirectory]
    title = ExifTag -> Keys [Char] -> [ImageFileDirectory]
    forall (f :: * -> *).
    (Monoid (f ImageFileDirectory), Applicative f) =>
    ExifTag -> Keys [Char] -> f ImageFileDirectory
    keyStr ExifTag
    TagDocumentName Keys [Char]
    Met.Title
      description :: [ImageFileDirectory]
    description = ExifTag -> Keys [Char] -> [ImageFileDirectory]
    forall (f :: * -> *).
    (Monoid (f ImageFileDirectory), Applicative f) =>
    ExifTag -> Keys [Char] -> f ImageFileDirectory
    keyStr ExifTag
    TagImageDescription Keys [Char]
    Met.Description
      software :: [ImageFileDirectory]
    software = ExifTag -> Keys [Char] -> [ImageFileDirectory]
    forall (f :: * -> *).
    (Monoid (f ImageFileDirectory), Applicative f) =>
    ExifTag -> Keys [Char] -> f ImageFileDirectory
    keyStr ExifTag
    TagSoftware Keys [Char]
    Met.Software

    extractTiffStringMetadata :: [ImageFileDirectory] -> Metadatas
    extractTiffStringMetadata :: [ImageFileDirectory] -> Metadatas
    extractTiffStringMetadata = Keys SourceFormat -> SourceFormat -> Metadatas -> Metadatas
    forall a.
    (Show a, NFData a) =>
    Keys a -> a -> Metadatas -> Metadatas
    Met.insert Keys SourceFormat
    Met.Format SourceFormat
    Met.SourceTiff (Metadatas -> Metadatas)
    -> ([ImageFileDirectory] -> Metadatas)
    -> [ImageFileDirectory]
    -> Metadatas
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ImageFileDirectory -> Metadatas)
    -> [ImageFileDirectory] -> Metadatas
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ImageFileDirectory -> Metadatas
    go where
      strMeta :: Keys [Char] -> ByteString -> Metadatas
    strMeta k :: Keys [Char]
    k = Keys [Char] -> [Char] -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton Keys [Char]
    k ([Char] -> Metadatas)
    -> (ByteString -> [Char]) -> ByteString -> Metadatas
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [Char]
    BC.unpack
      exif :: ImageFileDirectory -> Metadatas
    exif ifd :: ImageFileDirectory
    ifd =
        Keys ExifData -> ExifData -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton (ExifTag -> Keys ExifData
    Met.Exif (ExifTag -> Keys ExifData) -> ExifTag -> Keys ExifData
    forall a b. (a -> b) -> a -> b
    $ ImageFileDirectory -> ExifTag
    ifdIdentifier ImageFileDirectory
    ifd) (ExifData -> Metadatas) -> ExifData -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ ImageFileDirectory -> ExifData
    ifdExtended ImageFileDirectory
    ifd
      inserter :: Metadatas -> (ExifTag, ExifData) -> Metadatas
    inserter acc :: Metadatas
    acc (k :: ExifTag
    k, v :: ExifData
    v) = Keys ExifData -> ExifData -> Metadatas -> Metadatas
    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 ifd :: ImageFileDirectory
    ifd =
        Keys ExifData -> ExifData -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton (ExifTag -> Keys ExifData
    Met.Exif (ExifTag -> Keys ExifData) -> ExifTag -> Keys ExifData
    forall a b. (a -> b) -> a -> b
    $ ImageFileDirectory -> ExifTag
    ifdIdentifier ImageFileDirectory
    ifd) (ExifData -> Metadatas)
    -> (Word32 -> ExifData) -> Word32 -> Metadatas
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word16 -> ExifData
    ExifShort (Word16 -> ExifData) -> (Word32 -> Word16) -> Word32 -> ExifData
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) (Word32 -> Metadatas) -> Word32 -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ ImageFileDirectory -> Word32
    ifdOffset ImageFileDirectory
    ifd

      go :: ImageFileDirectory -> Metadatas
      go :: ImageFileDirectory -> Metadatas
    go ifd :: ImageFileDirectory
    ifd = case (ImageFileDirectory -> ExifTag
    ifdIdentifier ImageFileDirectory
    ifd, ImageFileDirectory -> ExifData
    ifdExtended ImageFileDirectory
    ifd) of
        (TagArtist, ExifString v :: ByteString
    v) -> Keys [Char] -> ByteString -> Metadatas
    strMeta Keys [Char]
    Met.Author ByteString
    v
        (TagBitsPerSample, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagColorMap, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagCompression, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagCopyright, ExifString v :: ByteString
    v) -> Keys [Char] -> ByteString -> Metadatas
    strMeta Keys [Char]
    Met.Copyright ByteString
    v
        (TagDocumentName, ExifString v :: ByteString
    v) -> Keys [Char] -> ByteString -> Metadatas
    strMeta Keys [Char]
    Met.Title ByteString
    v
        (TagExifOffset, ExifIFD lst :: [(ExifTag, ExifData)]
    lst) -> (Metadatas -> (ExifTag, ExifData) -> Metadatas)
    -> Metadatas -> [(ExifTag, ExifData)] -> Metadatas
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    F.foldl' Metadatas -> (ExifTag, ExifData) -> Metadatas
    inserter Metadatas
    forall a. Monoid a => a
    mempty [(ExifTag, ExifData)]
    lst
        (TagImageDescription, ExifString v :: ByteString
    v) -> Keys [Char] -> ByteString -> Metadatas
    strMeta Keys [Char]
    Met.Description ByteString
    v
        (TagImageLength, _) -> Keys Word -> Word -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton Keys Word
    Met.Height (Word -> Metadatas) -> (Word32 -> Word) -> Word32 -> Metadatas
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Metadatas) -> Word32 -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ ImageFileDirectory -> Word32
    ifdOffset ImageFileDirectory
    ifd
        (TagImageWidth, _) -> Keys Word -> Word -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton Keys Word
    Met.Width (Word -> Metadatas) -> (Word32 -> Word) -> Word32 -> Metadatas
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Metadatas) -> Word32 -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ ImageFileDirectory -> Word32
    ifdOffset ImageFileDirectory
    ifd
        (TagJPEGACTables, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGDCTables, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGInterchangeFormat, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGInterchangeFormatLength, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGLosslessPredictors, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGPointTransforms, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGQTables, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJPEGRestartInterval, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagJpegProc, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagModel, v :: ExifData
    v) -> Keys ExifData -> ExifData -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton (ExifTag -> Keys ExifData
    Met.Exif ExifTag
    TagModel) ExifData
    v
        (TagMake, v :: ExifData
    v) -> Keys ExifData -> ExifData -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton (ExifTag -> Keys ExifData
    Met.Exif ExifTag
    TagMake) ExifData
    v
        (TagOrientation, _) -> ImageFileDirectory -> Metadatas
    exifShort ImageFileDirectory
    ifd
        (TagResolutionUnit, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagRowPerStrip, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagSamplesPerPixel, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagSoftware, ExifString v :: ByteString
    v) -> Keys [Char] -> ByteString -> Metadatas
    strMeta Keys [Char]
    Met.Software ByteString
    v
        (TagStripByteCounts, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagStripOffsets, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagTileByteCount, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagTileLength, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagTileOffset, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagTileWidth, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagUnknown _, _) -> ImageFileDirectory -> Metadatas
    exif ImageFileDirectory
    ifd
        (TagXResolution, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagYCbCrCoeff, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagYCbCrPositioning, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagYCbCrSubsampling, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        (TagYResolution, _) -> Metadatas
    forall a. Monoid a => a
    mempty
        _ -> Metadatas
    forall a. Monoid a => a
    mempty

    byTag :: ExifTag -> ImageFileDirectory -> Bool
    byTag :: ExifTag -> ImageFileDirectory -> Bool
    byTag t :: ExifTag
    t ifd :: ImageFileDirectory
    ifd = ImageFileDirectory -> ExifTag
    ifdIdentifier ImageFileDirectory
    ifd ExifTag -> ExifTag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExifTag
    t

    data TiffResolutionUnit
      = ResolutionUnitUnknown
      | ResolutionUnitInch
      | ResolutionUnitCentimeter

    unitOfIfd :: ImageFileDirectory -> TiffResolutionUnit
    unitOfIfd :: ImageFileDirectory -> TiffResolutionUnit
    unitOfIfd ifd :: ImageFileDirectory
    ifd = case (ImageFileDirectory -> IfdType
    ifdType ImageFileDirectory
    ifd, ImageFileDirectory -> Word32
    ifdOffset ImageFileDirectory
    ifd) of
      (TypeShort, 1) -> TiffResolutionUnit
    ResolutionUnitUnknown
      (TypeShort, 2) -> TiffResolutionUnit
    ResolutionUnitInch
      (TypeShort, 3) -> TiffResolutionUnit
    ResolutionUnitCentimeter
      _ -> TiffResolutionUnit
    ResolutionUnitUnknown

    extractTiffDpiMetadata :: [ImageFileDirectory] -> Metadatas
    extractTiffDpiMetadata :: [ImageFileDirectory] -> Metadatas
    extractTiffDpiMetadata lst :: [ImageFileDirectory]
    lst = Metadatas
    go where
      go :: Metadatas
    go = case ImageFileDirectory -> TiffResolutionUnit
    unitOfIfd (ImageFileDirectory -> TiffResolutionUnit)
    -> Maybe ImageFileDirectory -> Maybe TiffResolutionUnit
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ImageFileDirectory -> Bool)
    -> [ImageFileDirectory] -> Maybe ImageFileDirectory
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (ExifTag -> ImageFileDirectory -> Bool
    byTag ExifTag
    TagResolutionUnit) [ImageFileDirectory]
    lst of
        Nothing -> Metadatas
    forall a. Monoid a => a
    mempty
        Just ResolutionUnitUnknown -> Metadatas
    forall a. Monoid a => a
    mempty
        Just ResolutionUnitCentimeter -> (Word -> Word) -> Metadatas -> Metadatas
    forall b. Num b => (b -> Word) -> Metadatas -> Metadatas
    findDpis Word -> Word
    Met.dotsPerCentiMeterToDotPerInch Metadatas
    forall a. Monoid a => a
    mempty
        Just ResolutionUnitInch -> (Word -> Word) -> Metadatas -> Metadatas
    forall b. Num b => (b -> Word) -> Metadatas -> Metadatas
    findDpis Word -> Word
    forall a. a -> a
    id Metadatas
    forall a. Monoid a => a
    mempty

      findDpis :: (b -> Word) -> Metadatas -> Metadatas
    findDpis toDpi :: b -> Word
    toDpi =
         Keys Word -> ExifTag -> (b -> Word) -> Metadatas -> Metadatas
    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 (Metadatas -> Metadatas)
    -> (Metadatas -> Metadatas) -> Metadatas -> Metadatas
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Keys Word -> ExifTag -> (b -> Word) -> Metadatas -> Metadatas
    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 k :: Keys a
    k tag :: ExifTag
    tag toDpi :: b -> a
    toDpi metas :: Metadatas
    metas = case (ImageFileDirectory -> Bool)
    -> [ImageFileDirectory] -> Maybe ImageFileDirectory
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (ExifTag -> ImageFileDirectory -> Bool
    byTag ExifTag
    tag) [ImageFileDirectory]
    lst of
        Nothing -> Metadatas
    metas
        Just ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
    ifdExtended = ExifRational num :: Word32
    num den :: Word32
    den } ->
          Keys a -> a -> Metadatas -> Metadatas
    forall a.
    (Show a, NFData a) =>
    Keys a -> a -> Metadatas -> Metadatas
    Met.insert Keys a
    k (b -> a
    toDpi (b -> a) -> (Word32 -> b) -> Word32 -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> a) -> Word32 -> a
    forall a b. (a -> b) -> a -> b
    $ Word32
    num Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `div` Word32
    den) Metadatas
    metas
        Just _ -> Metadatas
    metas

    extractTiffMetadata :: [ImageFileDirectory] -> Metadatas
    extractTiffMetadata :: [ImageFileDirectory] -> Metadatas
    extractTiffMetadata lst :: [ImageFileDirectory]
    lst = [ImageFileDirectory] -> Metadatas
    extractTiffDpiMetadata [ImageFileDirectory]
    lst Metadatas -> Metadatas -> Metadatas
    forall a. Semigroup a => a -> a -> a
    <> [ImageFileDirectory] -> Metadatas
    extractTiffStringMetadata [ImageFileDirectory]
    lst