{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Codec.Picture.Tiff.Internal.Types
    ( BinaryParam( .. )
    , Endianness( .. )
    , TiffHeader( .. )
    , TiffPlanarConfiguration( .. )
    , TiffCompression( .. )
    , IfdType( .. )
    , TiffColorspace( .. )
    , TiffSampleFormat( .. )
    , ImageFileDirectory( .. )
    , ExtraSample( .. )
    , Predictor( .. )

    , planarConfgOfConstant
    , constantToPlaneConfiguration
    , unpackSampleFormat
    , packSampleFormat
    , word16OfTag
    , unpackPhotometricInterpretation
    , packPhotometricInterpretation
    , codeOfExtraSample
    , unPackCompression
    , packCompression 
    , predictorOfConstant
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( (<$>), (<*>), pure )
#endif

import Control.Monad( forM_, when, replicateM, )
import Data.Bits( (.&.), unsafeShiftR )
import Data.Binary( Binary( .. ) )
import Data.Binary.Get( Get
                      , getWord16le, getWord16be
                      , getWord32le, getWord32be
                      , bytesRead
                      , skip
                      , getByteString
                      )
import Data.Binary.Put( Put
                      , putWord16le, putWord16be
                      , putWord32le, putWord32be
                      , putByteString
                      )
import Data.Function( on )
import Data.List( sortBy, mapAccumL )
import qualified Data.Vector as V
import qualified Data.ByteString as B
import Data.Int( Int32 )
import Data.Word( Word8, Word16, Word32 )

import Codec.Picture.Metadata.Exif
{-import Debug.Trace-}

data Endianness
  = EndianLittle
  | EndianBig
  deriving (Endianness -> Endianness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endianness -> Endianness -> Bool
$c/= :: Endianness -> Endianness -> Bool
== :: Endianness -> Endianness -> Bool
$c== :: Endianness -> Endianness -> Bool
Eq, Int -> Endianness -> ShowS
[Endianness] -> ShowS
Endianness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endianness] -> ShowS
$cshowList :: [Endianness] -> ShowS
show :: Endianness -> String
$cshow :: Endianness -> String
showsPrec :: Int -> Endianness -> ShowS
$cshowsPrec :: Int -> Endianness -> ShowS
Show)

instance Binary Endianness where
  put :: Endianness -> Put
put Endianness
EndianLittle = Word16 -> Put
putWord16le Word16
0x4949
  put Endianness
EndianBig = Word16 -> Put
putWord16le Word16
0x4D4D

  get :: Get Endianness
get = do
    Word16
tag <- Get Word16
getWord16le
    case Word16
tag of
      Word16
0x4949 -> forall (m :: * -> *) a. Monad m => a -> m a
return Endianness
EndianLittle
      Word16
0x4D4D -> forall (m :: * -> *) a. Monad m => a -> m a
return Endianness
EndianBig
      Word16
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid endian tag value"

-- | Because having a polymorphic get with endianness is to nice

-- to pass on, introducing this helper type class, which is just

-- a superset of Binary, but formalising a parameter passing

-- into it.

class BinaryParam a b where
  getP :: a -> Get b
  putP :: a -> b -> Put

data TiffHeader = TiffHeader
  { TiffHeader -> Endianness
hdrEndianness :: !Endianness
  , TiffHeader -> Word32
hdrOffset     :: {-# UNPACK #-} !Word32
  }
  deriving (TiffHeader -> TiffHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TiffHeader -> TiffHeader -> Bool
$c/= :: TiffHeader -> TiffHeader -> Bool
== :: TiffHeader -> TiffHeader -> Bool
$c== :: TiffHeader -> TiffHeader -> Bool
Eq, Int -> TiffHeader -> ShowS
[TiffHeader] -> ShowS
TiffHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TiffHeader] -> ShowS
$cshowList :: [TiffHeader] -> ShowS
show :: TiffHeader -> String
$cshow :: TiffHeader -> String
showsPrec :: Int -> TiffHeader -> ShowS
$cshowsPrec :: Int -> TiffHeader -> ShowS
Show)

instance BinaryParam Endianness Word16 where
  putP :: Endianness -> Word16 -> Put
putP Endianness
EndianLittle = Word16 -> Put
putWord16le
  putP Endianness
EndianBig = Word16 -> Put
putWord16be

  getP :: Endianness -> Get Word16
getP Endianness
EndianLittle = Get Word16
getWord16le
  getP Endianness
EndianBig = Get Word16
getWord16be

instance BinaryParam Endianness Int32 where
  putP :: Endianness -> Int32 -> Put
putP Endianness
en Int32
v = forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
en forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v :: Word32)
  getP :: Endianness -> Get Int32
getP Endianness
en = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. BinaryParam a b => a -> Get b
getP Endianness
en :: Get Word32) 

instance BinaryParam Endianness Word32 where
  putP :: Endianness -> Word32 -> Put
putP Endianness
EndianLittle = Word32 -> Put
putWord32le
  putP Endianness
EndianBig = Word32 -> Put
putWord32be

  getP :: Endianness -> Get Word32
getP Endianness
EndianLittle = Get Word32
getWord32le
  getP Endianness
EndianBig = Get Word32
getWord32be

instance Binary TiffHeader where
  put :: TiffHeader -> Put
put TiffHeader
hdr = do
    let endian :: Endianness
endian = TiffHeader -> Endianness
hdrEndianness TiffHeader
hdr
    forall t. Binary t => t -> Put
put Endianness
endian
    forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endian (Word16
42 :: Word16)
    forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endian forall a b. (a -> b) -> a -> b
$ TiffHeader -> Word32
hdrOffset TiffHeader
hdr

  get :: Get TiffHeader
get = do
    Endianness
endian <- forall t. Binary t => Get t
get
    Word16
magic <- forall a b. BinaryParam a b => a -> Get b
getP Endianness
endian
    let magicValue :: Word16
magicValue = Word16
42 :: Word16
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
magic forall a. Eq a => a -> a -> Bool
/= Word16
magicValue)
         (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid TIFF magic number")
    Endianness -> Word32 -> TiffHeader
TiffHeader Endianness
endian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. BinaryParam a b => a -> Get b
getP Endianness
endian

data TiffPlanarConfiguration
  = PlanarConfigContig    -- = 1

  | PlanarConfigSeparate  -- = 2


planarConfgOfConstant :: Word32 -> Get TiffPlanarConfiguration
planarConfgOfConstant :: Word32 -> Get TiffPlanarConfiguration
planarConfgOfConstant Word32
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffPlanarConfiguration
PlanarConfigContig
planarConfgOfConstant Word32
1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffPlanarConfiguration
PlanarConfigContig
planarConfgOfConstant Word32
2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffPlanarConfiguration
PlanarConfigSeparate
planarConfgOfConstant Word32
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown planar constant (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
v forall a. [a] -> [a] -> [a]
++ String
")"

constantToPlaneConfiguration :: TiffPlanarConfiguration -> Word16
constantToPlaneConfiguration :: TiffPlanarConfiguration -> Word16
constantToPlaneConfiguration TiffPlanarConfiguration
PlanarConfigContig = Word16
1
constantToPlaneConfiguration TiffPlanarConfiguration
PlanarConfigSeparate = Word16
2

data TiffCompression
  = CompressionNone           -- 1

  | CompressionModifiedRLE    -- 2

  | CompressionLZW            -- 5

  | CompressionJPEG           -- 6

  | CompressionPackBit        -- 32273


data IfdType
  = TypeByte
  | TypeAscii
  | TypeShort
  | TypeLong
  | TypeRational
  | TypeSByte
  | TypeUndefined
  | TypeSignedShort
  | TypeSignedLong
  | TypeSignedRational
  | TypeFloat
  | TypeDouble
  deriving Int -> IfdType -> ShowS
[IfdType] -> ShowS
IfdType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IfdType] -> ShowS
$cshowList :: [IfdType] -> ShowS
show :: IfdType -> String
$cshow :: IfdType -> String
showsPrec :: Int -> IfdType -> ShowS
$cshowsPrec :: Int -> IfdType -> ShowS
Show

instance BinaryParam Endianness IfdType where
    getP :: Endianness -> Get IfdType
getP Endianness
endianness = forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Get IfdType
conv where
      conv :: Word16 -> Get IfdType
      conv :: Word16 -> Get IfdType
conv Word16
v = case Word16
v of
        Word16
1  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeByte
        Word16
2  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeAscii
        Word16
3  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeShort
        Word16
4  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeLong
        Word16
5  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeRational
        Word16
6  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeSByte
        Word16
7  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeUndefined
        Word16
8  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeSignedShort
        Word16
9  -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeSignedLong
        Word16
10 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeSignedRational
        Word16
11 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeFloat
        Word16
12 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfdType
TypeDouble
        Word16
_  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid TIF directory type"

    putP :: Endianness -> IfdType -> Put
putP Endianness
endianness = forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfdType -> Word16
conv where
      conv :: IfdType -> Word16
      conv :: IfdType -> Word16
conv IfdType
v = case IfdType
v of
        IfdType
TypeByte -> Word16
1
        IfdType
TypeAscii -> Word16
2
        IfdType
TypeShort -> Word16
3
        IfdType
TypeLong -> Word16
4
        IfdType
TypeRational -> Word16
5
        IfdType
TypeSByte -> Word16
6
        IfdType
TypeUndefined -> Word16
7
        IfdType
TypeSignedShort -> Word16
8
        IfdType
TypeSignedLong -> Word16
9
        IfdType
TypeSignedRational -> Word16
10
        IfdType
TypeFloat -> Word16
11
        IfdType
TypeDouble -> Word16
12

instance BinaryParam Endianness ExifTag where
  getP :: Endianness -> Get ExifTag
getP Endianness
endianness = Word16 -> ExifTag
tagOfWord16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness
  putP :: Endianness -> ExifTag -> Put
putP Endianness
endianness = forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExifTag -> Word16
word16OfTag

data Predictor
  = PredictorNone                   -- 1

  | PredictorHorizontalDifferencing -- 2

  deriving Predictor -> Predictor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Predictor -> Predictor -> Bool
$c/= :: Predictor -> Predictor -> Bool
== :: Predictor -> Predictor -> Bool
$c== :: Predictor -> Predictor -> Bool
Eq

predictorOfConstant :: Word32 -> Get Predictor
predictorOfConstant :: Word32 -> Get Predictor
predictorOfConstant Word32
1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Predictor
PredictorNone
predictorOfConstant Word32
2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Predictor
PredictorHorizontalDifferencing
predictorOfConstant Word32
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown predictor (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
v forall a. [a] -> [a] -> [a]
++ String
")"

paddWrite :: B.ByteString -> Put
paddWrite :: ByteString -> Put
paddWrite ByteString
str = ByteString -> Put
putByteString ByteString
str forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
padding where
  zero :: Word8
zero = Word8
0 :: Word8
  padding :: Put
padding = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
str)) forall a b. (a -> b) -> a -> b
$ forall t. Binary t => t -> Put
put Word8
zero

instance BinaryParam (Endianness, Int, ImageFileDirectory) ExifData where
  putP :: (Endianness, Int, ImageFileDirectory) -> ExifData -> Put
putP (Endianness
endianness, Int
_, ImageFileDirectory
_) = ExifData -> Put
dump
    where
      dump :: ExifData -> Put
dump ExifData
ExifNone = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifLong Word32
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifShort Word16
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifIFD [(ExifTag, ExifData)]
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifString ByteString
bstr) = ByteString -> Put
paddWrite ByteString
bstr
      dump (ExifUndefined ByteString
bstr) = ByteString -> Put
paddWrite ByteString
bstr
      -- wrong if length == 2

      dump (ExifShorts Vector Word16
shorts) = forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness) Vector Word16
shorts
      dump (ExifLongs Vector Word32
longs) = forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness) Vector Word32
longs
      dump (ExifRational Word32
a Word32
b) = forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Word32
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Word32
b
      dump (ExifSignedRational Int32
a Int32
b) = forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Int32
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Int32
b

  getP :: (Endianness, Int, ImageFileDirectory) -> Get ExifData
getP (Endianness
endianness, Int
maxi, ImageFileDirectory
ifd) = ImageFileDirectory -> Get ExifData
fetcher ImageFileDirectory
ifd
    where
      align :: ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory { ifdOffset :: ImageFileDirectory -> Word32
ifdOffset = Word32
offset } Get ExifData
act = do
        Int64
readed <- Get Int64
bytesRead
        let delta :: Int64
delta = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset forall a. Num a => a -> a -> a
- Int64
readed
        if Word32
offset forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxi Bool -> Bool -> Bool
|| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
readed forall a. Ord a => a -> a -> Bool
> Word32
offset then
          forall (f :: * -> *) a. Applicative f => a -> f a
pure ExifData
ExifNone
        else do
          Int -> Get ()
skip forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
delta
          Get ExifData
act

      getE :: (BinaryParam Endianness a) => Get a
      getE :: forall a. BinaryParam Endianness a => Get a
getE = forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness

      getVec :: a -> m a -> m (Vector a)
getVec a
count = forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
count)

      immediateBytes :: p -> [a]
immediateBytes p
ofs =
        let bytes :: [a]
bytes = [forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (p
ofs forall a. Bits a => a -> a -> a
.&. p
0xFF000000) forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
3 forall a. Num a => a -> a -> a
* Int
8)
                    ,forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (p
ofs forall a. Bits a => a -> a -> a
.&. p
0x00FF0000) forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
2 forall a. Num a => a -> a -> a
* Int
8)
                    ,forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (p
ofs forall a. Bits a => a -> a -> a
.&. p
0x0000FF00) forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
1 forall a. Num a => a -> a -> a
* Int
8)
                    ,forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$  p
ofs forall a. Bits a => a -> a -> a
.&. p
0x000000FF
                    ]
        in case Endianness
endianness of
             Endianness
EndianLittle -> forall a. [a] -> [a]
reverse [a]
bytes
             Endianness
EndianBig    -> [a]
bytes

      fetcher :: ImageFileDirectory -> Get ExifData
fetcher ImageFileDirectory { ifdIdentifier :: ImageFileDirectory -> ExifTag
ifdIdentifier = ExifTag
TagExifOffset
                                 , ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeLong
                                 , ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 } = do
         ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ do
            let byOffset :: [ImageFileDirectory] -> [ImageFileDirectory]
byOffset = 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` ImageFileDirectory -> Word32
ifdOffset)
                cleansIfds :: [ImageFileDirectory] -> [ImageFileDirectory]
cleansIfds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endianness -> ImageFileDirectory -> ImageFileDirectory
cleanImageFileDirectory Endianness
endianness)
            [ImageFileDirectory]
subIfds <- [ImageFileDirectory] -> [ImageFileDirectory]
cleansIfds forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImageFileDirectory] -> [ImageFileDirectory]
byOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness
            [ImageFileDirectory]
cleaned <- Endianness
-> Int -> [ImageFileDirectory] -> Get [ImageFileDirectory]
fetchExtended Endianness
endianness Int
maxi forall a b. (a -> b) -> a -> b
$ 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` ImageFileDirectory -> Word32
ifdOffset) [ImageFileDirectory]
subIfds
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(ExifTag, ExifData)] -> ExifData
ExifIFD [(ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
fd, ImageFileDirectory -> ExifData
ifdExtended ImageFileDirectory
fd) | ImageFileDirectory
fd <- [ImageFileDirectory]
cleaned]
         {-  
      fetcher ImageFileDirectory { ifdIdentifier = TagGPSInfo
                                 , ifdType = TypeLong
                                 , ifdCount = 1 } = do
         align ifd 
         subIfds <- fmap (cleanImageFileDirectory endianness) <$> getP endianness
         cleaned <- fetchExtended endianness subIfds
         pure $ ExifIFD [(ifdIdentifier fd, ifdExtended fd) | fd <- cleaned]
        -}
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeUndefined, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
count } | Word32
count forall a. Ord a => a -> a -> Bool
> Word32
4 =
         ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ ByteString -> ExifData
ExifUndefined forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count)
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeUndefined, ifdOffset :: ImageFileDirectory -> Word32
ifdOffset = Word32
ofs } =
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExifData
ExifUndefined forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdCount ImageFileDirectory
ifd)
              (forall {p} {a}. (Integral p, Bits p, Num a) => p -> [a]
immediateBytes Word32
ofs)
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeAscii, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
count } | Word32
count forall a. Ord a => a -> a -> Bool
> Word32
4 =
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ ByteString -> ExifData
ExifString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count)
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeAscii, ifdOffset :: ImageFileDirectory -> Word32
ifdOffset = Word32
ofs } =
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExifData
ExifString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdCount ImageFileDirectory
ifd)
              (forall {p} {a}. (Integral p, Bits p, Num a) => p -> [a]
immediateBytes Word32
ofs)
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeShort, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
2, ifdOffset :: ImageFileDirectory -> Word32
ifdOffset = Word32
ofs } =
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> ExifData
ExifShorts forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> Vector a
V.fromListN Int
2 [Word16]
valList
            where high :: Word16
high = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
ofs forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16
                  low :: Word16
low = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
ofs forall a. Bits a => a -> a -> a
.&. Word32
0xFFFF
                  valList :: [Word16]
valList = case Endianness
endianness of
                    Endianness
EndianLittle -> [Word16
low, Word16
high]
                    Endianness
EndianBig -> [Word16
high, Word16
low]
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeRational, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 } = do
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> ExifData
ExifRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. BinaryParam a b => a -> Get b
getP Endianness
EndianLittle forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. BinaryParam a b => a -> Get b
getP Endianness
EndianLittle
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeSignedRational, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 } = do
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> ExifData
ExifSignedRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. BinaryParam a b => a -> Get b
getP Endianness
EndianLittle forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. BinaryParam a b => a -> Get b
getP Endianness
EndianLittle
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeShort, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 } =
          forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeShort, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
count } | Word32
count forall a. Ord a => a -> a -> Bool
> Word32
2 =
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ Vector Word16 -> ExifData
ExifShorts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {a} {a}.
(Monad m, Integral a) =>
a -> m a -> m (Vector a)
getVec Word32
count forall a. BinaryParam Endianness a => Get a
getE
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeLong, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 } =
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ExifData
ExifLong 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
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeLong, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
count } | Word32
count forall a. Ord a => a -> a -> Bool
> Word32
1 =
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd forall a b. (a -> b) -> a -> b
$ Vector Word32 -> ExifData
ExifLongs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {a} {a}.
(Monad m, Integral a) =>
a -> m a -> m (Vector a)
getVec Word32
count forall a. BinaryParam Endianness a => Get a
getE
      fetcher ImageFileDirectory
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ExifData
ExifNone

cleanImageFileDirectory :: Endianness -> ImageFileDirectory -> ImageFileDirectory
cleanImageFileDirectory :: Endianness -> ImageFileDirectory -> ImageFileDirectory
cleanImageFileDirectory Endianness
EndianBig ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 }) = IfdType -> ImageFileDirectory
aux forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> IfdType
ifdType ImageFileDirectory
ifd
  where
    aux :: IfdType -> ImageFileDirectory
aux IfdType
TypeShort = ImageFileDirectory
ifd { ifdOffset :: Word32
ifdOffset = ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
ifd forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16 }
    aux IfdType
_ = ImageFileDirectory
ifd
cleanImageFileDirectory Endianness
_ ImageFileDirectory
ifd = ImageFileDirectory
ifd

fetchExtended :: Endianness -> Int -> [ImageFileDirectory] -> Get [ImageFileDirectory]
fetchExtended :: Endianness
-> Int -> [ImageFileDirectory] -> Get [ImageFileDirectory]
fetchExtended Endianness
endian Int
maxi = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \ImageFileDirectory
ifd -> do
  ExifData
v <- forall a b. BinaryParam a b => a -> Get b
getP (Endianness
endian, Int
maxi, ImageFileDirectory
ifd)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImageFileDirectory
ifd { ifdExtended :: ExifData
ifdExtended = ExifData
v }

-- | All the IFD must be written in order according to the tag

-- value of the IFD. To avoid getting to much restriction in the

-- serialization code, just sort it.

orderIfdByTag :: [ImageFileDirectory] -> [ImageFileDirectory]
orderIfdByTag :: [ImageFileDirectory] -> [ImageFileDirectory]
orderIfdByTag = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ImageFileDirectory -> ImageFileDirectory -> Ordering
comparer where
  comparer :: ImageFileDirectory -> ImageFileDirectory -> Ordering
comparer ImageFileDirectory
a ImageFileDirectory
b = forall a. Ord a => a -> a -> Ordering
compare Word16
t1 Word16
t2 where
    t1 :: Word16
t1 = ExifTag -> Word16
word16OfTag forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
a
    t2 :: Word16
t2 = ExifTag -> Word16
word16OfTag forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
b

-- | Given an official offset and a list of IFD, update the offset information

-- of the IFD with extended data.

setupIfdOffsets :: Word32 -> [ImageFileDirectory] -> (Word32, [ImageFileDirectory])
setupIfdOffsets :: Word32 -> [ImageFileDirectory] -> (Word32, [ImageFileDirectory])
setupIfdOffsets Word32
initialOffset [ImageFileDirectory]
lst = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Word32 -> ImageFileDirectory -> (Word32, ImageFileDirectory)
updater Word32
startExtended [ImageFileDirectory]
lst
  where ifdElementCount :: Word32
ifdElementCount = 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
length [ImageFileDirectory]
lst
        ifdSize :: Word32
ifdSize = Word32
12
        ifdCountSize :: Word32
ifdCountSize = Word32
2
        nextOffsetSize :: Word32
nextOffsetSize = Word32
4
        startExtended :: Word32
startExtended = Word32
initialOffset
                     forall a. Num a => a -> a -> a
+ Word32
ifdElementCount forall a. Num a => a -> a -> a
* Word32
ifdSize
                     forall a. Num a => a -> a -> a
+ Word32
ifdCountSize forall a. Num a => a -> a -> a
+ Word32
nextOffsetSize

        paddedSize :: ByteString -> b
paddedSize ByteString
blob = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
blobLength forall a. Num a => a -> a -> a
+ Int
padding where
          blobLength :: Int
blobLength = ByteString -> Int
B.length ByteString
blob
          padding :: Int
padding = if forall a. Integral a => a -> Bool
odd Int
blobLength then Int
1 else Int
0

        updater :: Word32 -> ImageFileDirectory -> (Word32, ImageFileDirectory)
updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdIdentifier :: ImageFileDirectory -> ExifTag
ifdIdentifier = ExifTag
TagExifOffset }) =
            (Word32
ix, ImageFileDirectory
ifd { ifdOffset :: Word32
ifdOffset = Word32
ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifUndefined ByteString
b }) =
            (Word32
ix forall a. Num a => a -> a -> a
+ forall {b}. Num b => ByteString -> b
paddedSize ByteString
b, ImageFileDirectory
ifd { ifdOffset :: Word32
ifdOffset = Word32
ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifString ByteString
b }) =
            (Word32
ix forall a. Num a => a -> a -> a
+ forall {b}. Num b => ByteString -> b
paddedSize ByteString
b, ImageFileDirectory
ifd { ifdOffset :: Word32
ifdOffset = Word32
ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifLongs Vector Word32
v })
            | forall a. Vector a -> Int
V.length Vector Word32
v forall a. Ord a => a -> a -> Bool
> Int
1 = ( Word32
ix forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
V.length Vector Word32
v forall a. Num a => a -> a -> a
* Int
4)
                               , ImageFileDirectory
ifd { ifdOffset :: Word32
ifdOffset = Word32
ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifShorts Vector Word16
v })
            | forall a. Vector a -> Int
V.length Vector Word16
v forall a. Ord a => a -> a -> Bool
> Int
2 = ( Word32
ix forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
V.length Vector Word16
v forall a. Num a => a -> a -> a
* Int
2)
                             , ImageFileDirectory
ifd { ifdOffset :: Word32
ifdOffset = Word32
ix })
        updater Word32
ix ImageFileDirectory
ifd = (Word32
ix, ImageFileDirectory
ifd)

instance BinaryParam B.ByteString (TiffHeader, [[ImageFileDirectory]]) where
  putP :: ByteString -> (TiffHeader, [[ImageFileDirectory]]) -> Put
putP ByteString
rawData (TiffHeader
hdr, [[ImageFileDirectory]]
ifds) = do
    forall t. Binary t => t -> Put
put TiffHeader
hdr
    ByteString -> Put
putByteString ByteString
rawData
    let endianness :: Endianness
endianness = TiffHeader -> Endianness
hdrEndianness TiffHeader
hdr
        (Word32
_, [[ImageFileDirectory]]
offseted) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
            (\Word32
ix [ImageFileDirectory]
ifd -> Word32 -> [ImageFileDirectory] -> (Word32, [ImageFileDirectory])
setupIfdOffsets Word32
ix forall a b. (a -> b) -> a -> b
$ [ImageFileDirectory] -> [ImageFileDirectory]
orderIfdByTag [ImageFileDirectory]
ifd)
            (TiffHeader -> Word32
hdrOffset TiffHeader
hdr)
            [[ImageFileDirectory]]
ifds
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[ImageFileDirectory]]
offseted forall a b. (a -> b) -> a -> b
$ \[ImageFileDirectory]
list -> do
        forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness [ImageFileDirectory]
list
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ImageFileDirectory
field -> forall a b. BinaryParam a b => a -> b -> Put
putP (Endianness
endianness, (Int
0::Int), ImageFileDirectory
field) forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifData
ifdExtended ImageFileDirectory
field) [ImageFileDirectory]
list

  getP :: ByteString -> Get (TiffHeader, [[ImageFileDirectory]])
getP ByteString
raw = do
    TiffHeader
hdr <- forall t. Binary t => Get t
get
    Int64
readed <- Get Int64
bytesRead
    Int -> Get ()
skip 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
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (TiffHeader -> Word32
hdrOffset TiffHeader
hdr) forall a. Num a => a -> a -> a
- Int64
readed
    let endian :: Endianness
endian = TiffHeader -> Endianness
hdrEndianness TiffHeader
hdr
        byOffset :: [ImageFileDirectory] -> [ImageFileDirectory]
byOffset = 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` ImageFileDirectory -> Word32
ifdOffset)
        cleanIfds :: [ImageFileDirectory] -> [ImageFileDirectory]
cleanIfds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endianness -> ImageFileDirectory -> ImageFileDirectory
cleanImageFileDirectory Endianness
endian)

    [ImageFileDirectory]
ifd <-  [ImageFileDirectory] -> [ImageFileDirectory]
cleanIfds forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImageFileDirectory] -> [ImageFileDirectory]
byOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. BinaryParam a b => a -> Get b
getP Endianness
endian
    [ImageFileDirectory]
cleaned <- Endianness
-> Int -> [ImageFileDirectory] -> Get [ImageFileDirectory]
fetchExtended Endianness
endian (ByteString -> Int
B.length ByteString
raw) [ImageFileDirectory]
ifd
    forall (m :: * -> *) a. Monad m => a -> m a
return (TiffHeader
hdr, [[ImageFileDirectory]
cleaned])

data TiffSampleFormat
  = TiffSampleUint
  | TiffSampleInt
  | TiffSampleFloat
  | TiffSampleUnknown
  deriving TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TiffSampleFormat -> TiffSampleFormat -> Bool
$c/= :: TiffSampleFormat -> TiffSampleFormat -> Bool
== :: TiffSampleFormat -> TiffSampleFormat -> Bool
$c== :: TiffSampleFormat -> TiffSampleFormat -> Bool
Eq

unpackSampleFormat :: Word32 -> Get TiffSampleFormat
unpackSampleFormat :: Word32 -> Get TiffSampleFormat
unpackSampleFormat Word32
v = case Word32
v of
  Word32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleUint
  Word32
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleInt
  Word32
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleFloat
  Word32
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleUnknown
  Word32
vv -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Undefined data format (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
vv forall a. [a] -> [a] -> [a]
++ String
")"

packSampleFormat :: TiffSampleFormat -> Word32
packSampleFormat :: TiffSampleFormat -> Word32
packSampleFormat TiffSampleFormat
TiffSampleUint    = Word32
1
packSampleFormat TiffSampleFormat
TiffSampleInt     = Word32
2
packSampleFormat TiffSampleFormat
TiffSampleFloat   = Word32
3
packSampleFormat TiffSampleFormat
TiffSampleUnknown = Word32
4

data ImageFileDirectory = ImageFileDirectory
  { ImageFileDirectory -> ExifTag
ifdIdentifier :: !ExifTag -- Word16

  , ImageFileDirectory -> IfdType
ifdType       :: !IfdType -- Word16

  , ImageFileDirectory -> Word32
ifdCount      :: !Word32
  , ImageFileDirectory -> Word32
ifdOffset     :: !Word32
  , ImageFileDirectory -> ExifData
ifdExtended   :: !ExifData
  }
  deriving Int -> ImageFileDirectory -> ShowS
[ImageFileDirectory] -> ShowS
ImageFileDirectory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageFileDirectory] -> ShowS
$cshowList :: [ImageFileDirectory] -> ShowS
show :: ImageFileDirectory -> String
$cshow :: ImageFileDirectory -> String
showsPrec :: Int -> ImageFileDirectory -> ShowS
$cshowsPrec :: Int -> ImageFileDirectory -> ShowS
Show

instance BinaryParam Endianness ImageFileDirectory where
  getP :: Endianness -> Get ImageFileDirectory
getP Endianness
endianness =
    ExifTag
-> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
ImageFileDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BinaryParam Endianness a => Get a
getE forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. BinaryParam Endianness a => Get a
getE forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. BinaryParam Endianness a => Get a
getE forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. BinaryParam Endianness a => Get a
getE
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExifData
ExifNone
        where getE :: (BinaryParam Endianness a) => Get a
              getE :: forall a. BinaryParam Endianness a => Get a
getE = forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness

  putP :: Endianness -> ImageFileDirectory -> Put
putP Endianness
endianness ImageFileDirectory
ifd = do
    let putE :: (BinaryParam Endianness a) => a -> Put
        putE :: forall a. BinaryParam Endianness a => a -> Put
putE = forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness
    forall a. BinaryParam Endianness a => a -> Put
putE forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
ifd
    forall a. BinaryParam Endianness a => a -> Put
putE forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> IfdType
ifdType ImageFileDirectory
ifd
    forall a. BinaryParam Endianness a => a -> Put
putE forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdCount ImageFileDirectory
ifd
    forall a. BinaryParam Endianness a => a -> Put
putE forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
ifd

instance BinaryParam Endianness [ImageFileDirectory] where
  getP :: Endianness -> Get [ImageFileDirectory]
getP Endianness
endianness = do
    Word16
count <- forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness :: Get Word16
    [ImageFileDirectory]
rez <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
count) forall a b. (a -> b) -> a -> b
$ forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness
    Word32
_ <- forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness :: Get Word32
    forall (f :: * -> *) a. Applicative f => a -> f a
pure [ImageFileDirectory]
rez


  putP :: Endianness -> [ImageFileDirectory] -> Put
putP Endianness
endianness [ImageFileDirectory]
lst = do
    let count :: Word16
count = 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
length [ImageFileDirectory]
lst :: Word16
    forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Word16
count
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness) [ImageFileDirectory]
lst
    forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness (Word32
0 :: Word32)

data TiffColorspace
  = TiffMonochromeWhite0 -- ^ 0

  | TiffMonochrome       -- ^ 1

  | TiffRGB              -- ^ 2

  | TiffPaleted          -- ^ 3

  | TiffTransparencyMask -- ^ 4

  | TiffCMYK             -- ^ 5

  | TiffYCbCr            -- ^ 6

  | TiffCIELab           -- ^ 8



packPhotometricInterpretation :: TiffColorspace -> Word16
packPhotometricInterpretation :: TiffColorspace -> Word16
packPhotometricInterpretation TiffColorspace
v = case TiffColorspace
v of
  TiffColorspace
TiffMonochromeWhite0 -> Word16
0
  TiffColorspace
TiffMonochrome       -> Word16
1
  TiffColorspace
TiffRGB              -> Word16
2
  TiffColorspace
TiffPaleted          -> Word16
3
  TiffColorspace
TiffTransparencyMask -> Word16
4
  TiffColorspace
TiffCMYK             -> Word16
5
  TiffColorspace
TiffYCbCr            -> Word16
6
  TiffColorspace
TiffCIELab           -> Word16
8

unpackPhotometricInterpretation :: Word32 -> Get TiffColorspace
unpackPhotometricInterpretation :: Word32 -> Get TiffColorspace
unpackPhotometricInterpretation Word32
v = case Word32
v of
  Word32
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffMonochromeWhite0
  Word32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffMonochrome
  Word32
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffRGB
  Word32
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffPaleted
  Word32
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffTransparencyMask
  Word32
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffCMYK
  Word32
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffYCbCr
  Word32
8 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffCIELab
  Word32
vv -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unrecognized color space " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
vv

data ExtraSample
  = ExtraSampleUnspecified       -- ^ 0

  | ExtraSampleAssociatedAlpha   -- ^ 1

  | ExtraSampleUnassociatedAlpha -- ^ 2


codeOfExtraSample :: ExtraSample -> Word16
codeOfExtraSample :: ExtraSample -> Word16
codeOfExtraSample ExtraSample
v = case ExtraSample
v of
  ExtraSample
ExtraSampleUnspecified -> Word16
0
  ExtraSample
ExtraSampleAssociatedAlpha -> Word16
1
  ExtraSample
ExtraSampleUnassociatedAlpha -> Word16
2

unPackCompression :: Word32 -> Get TiffCompression
unPackCompression :: Word32 -> Get TiffCompression
unPackCompression Word32
v = case Word32
v of
  Word32
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionNone
  Word32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionNone
  Word32
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionModifiedRLE
  Word32
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionLZW
  Word32
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionJPEG
  Word32
32773 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionPackBit
  Word32
vv -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown compression scheme " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
vv

packCompression :: TiffCompression -> Word16
packCompression :: TiffCompression -> Word16
packCompression TiffCompression
v = case TiffCompression
v of
  TiffCompression
CompressionNone        -> Word16
1
  TiffCompression
CompressionModifiedRLE -> Word16
2
  TiffCompression
CompressionLZW         -> Word16
5
  TiffCompression
CompressionJPEG        -> Word16
6
  TiffCompression
CompressionPackBit     -> Word16
32773