{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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.DeepSeq( NFData(..) )
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 GHC.Generics( Generic )

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

data Endianness
  = EndianLittle
  | EndianBig
  deriving (Endianness -> Endianness -> Bool
(Endianness -> Endianness -> Bool)
-> (Endianness -> Endianness -> Bool) -> Eq Endianness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Endianness -> Endianness -> Bool
== :: Endianness -> Endianness -> Bool
$c/= :: Endianness -> Endianness -> Bool
/= :: Endianness -> Endianness -> Bool
Eq, Int -> Endianness -> ShowS
[Endianness] -> ShowS
Endianness -> String
(Int -> Endianness -> ShowS)
-> (Endianness -> String)
-> ([Endianness] -> ShowS)
-> Show Endianness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Endianness -> ShowS
showsPrec :: Int -> Endianness -> ShowS
$cshow :: Endianness -> String
show :: Endianness -> String
$cshowList :: [Endianness] -> ShowS
showList :: [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 -> Endianness -> Get Endianness
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Endianness
EndianLittle
      Word16
0x4D4D -> Endianness -> Get Endianness
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Endianness
EndianBig
      Word16
_ -> String -> Get Endianness
forall a. String -> Get a
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
(TiffHeader -> TiffHeader -> Bool)
-> (TiffHeader -> TiffHeader -> Bool) -> Eq TiffHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TiffHeader -> TiffHeader -> Bool
== :: TiffHeader -> TiffHeader -> Bool
$c/= :: TiffHeader -> TiffHeader -> Bool
/= :: TiffHeader -> TiffHeader -> Bool
Eq, Int -> TiffHeader -> ShowS
[TiffHeader] -> ShowS
TiffHeader -> String
(Int -> TiffHeader -> ShowS)
-> (TiffHeader -> String)
-> ([TiffHeader] -> ShowS)
-> Show TiffHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TiffHeader -> ShowS
showsPrec :: Int -> TiffHeader -> ShowS
$cshow :: TiffHeader -> String
show :: TiffHeader -> String
$cshowList :: [TiffHeader] -> ShowS
showList :: [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 = Endianness -> Word32 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
en (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v :: Word32)
  getP :: Endianness -> Get Int32
getP Endianness
en = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Endianness -> Get Word32
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
    Endianness -> Put
forall t. Binary t => t -> Put
put Endianness
endian
    Endianness -> Word16 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endian (Word16
42 :: Word16)
    Endianness -> Word32 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endian (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ TiffHeader -> Word32
hdrOffset TiffHeader
hdr

  get :: Get TiffHeader
get = do
    Endianness
endian <- Get Endianness
forall t. Binary t => Get t
get
    Word16
magic <- Endianness -> Get Word16
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endian
    let magicValue :: Word16
magicValue = Word16
42 :: Word16
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
magic Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
magicValue)
         (String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid TIFF magic number")
    Endianness -> Word32 -> TiffHeader
TiffHeader Endianness
endian (Word32 -> TiffHeader) -> Get Word32 -> Get TiffHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endianness -> Get Word32
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 = TiffPlanarConfiguration -> Get TiffPlanarConfiguration
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffPlanarConfiguration
PlanarConfigContig
planarConfgOfConstant Word32
1 = TiffPlanarConfiguration -> Get TiffPlanarConfiguration
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffPlanarConfiguration
PlanarConfigContig
planarConfgOfConstant Word32
2 = TiffPlanarConfiguration -> Get TiffPlanarConfiguration
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffPlanarConfiguration
PlanarConfigSeparate
planarConfgOfConstant Word32
v = String -> Get TiffPlanarConfiguration
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get TiffPlanarConfiguration)
-> String -> Get TiffPlanarConfiguration
forall a b. (a -> b) -> a -> b
$ String
"Unknown planar constant (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
v String -> ShowS
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 (IfdType -> IfdType -> Bool
(IfdType -> IfdType -> Bool)
-> (IfdType -> IfdType -> Bool) -> Eq IfdType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfdType -> IfdType -> Bool
== :: IfdType -> IfdType -> Bool
$c/= :: IfdType -> IfdType -> Bool
/= :: IfdType -> IfdType -> Bool
Eq, Int -> IfdType -> ShowS
[IfdType] -> ShowS
IfdType -> String
(Int -> IfdType -> ShowS)
-> (IfdType -> String) -> ([IfdType] -> ShowS) -> Show IfdType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IfdType -> ShowS
showsPrec :: Int -> IfdType -> ShowS
$cshow :: IfdType -> String
show :: IfdType -> String
$cshowList :: [IfdType] -> ShowS
showList :: [IfdType] -> ShowS
Show, (forall x. IfdType -> Rep IfdType x)
-> (forall x. Rep IfdType x -> IfdType) -> Generic IfdType
forall x. Rep IfdType x -> IfdType
forall x. IfdType -> Rep IfdType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IfdType -> Rep IfdType x
from :: forall x. IfdType -> Rep IfdType x
$cto :: forall x. Rep IfdType x -> IfdType
to :: forall x. Rep IfdType x -> IfdType
Generic)
instance NFData IfdType

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

    putP :: Endianness -> IfdType -> Put
putP Endianness
endianness = Endianness -> Word16 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness (Word16 -> Put) -> (IfdType -> Word16) -> IfdType -> Put
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 (Word16 -> ExifTag) -> Get Word16 -> Get ExifTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endianness -> Get Word16
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness
  putP :: Endianness -> ExifTag -> Put
putP Endianness
endianness = Endianness -> Word16 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness (Word16 -> Put) -> (ExifTag -> Word16) -> ExifTag -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExifTag -> Word16
word16OfTag

data Predictor
  = PredictorNone                   -- 1

  | PredictorHorizontalDifferencing -- 2

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

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

paddWrite :: B.ByteString -> Put
paddWrite :: ByteString -> Put
paddWrite ByteString
str = ByteString -> Put
putByteString ByteString
str Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
padding where
  zero :: Word8
zero = Word8
0 :: Word8
  padding :: Put
padding = Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
str)) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
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 = () -> Put
forall a. a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifLong Word32
_) = () -> Put
forall a. a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifShort Word16
_) = () -> Put
forall a. a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      dump (ExifIFD [(ExifTag, ExifData)]
_) = () -> Put
forall a. a -> PutM a
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) = (Word16 -> Put) -> Vector Word16 -> Put
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Endianness -> Word16 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness) Vector Word16
shorts
      dump (ExifLongs Vector Word32
longs) = (Word32 -> Put) -> Vector Word32 -> Put
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Endianness -> Word32 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness) Vector Word32
longs
      dump (ExifRational Word32
a Word32
b) = Endianness -> Word32 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Word32
a Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Endianness -> Word32 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Word32
b
      dump (ExifSignedRational Int32
a Int32
b) = Endianness -> Int32 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Int32
a Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Endianness -> Int32 -> Put
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 = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
readed
        if Word32
offset Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxi Bool -> Bool -> Bool
|| Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
readed Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
offset then
          ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExifData
ExifNone
        else do
          Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
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 = Endianness -> Get a
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness

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

      immediateBytes :: p -> [a]
immediateBytes p
ofs =
        let bytes :: [a]
bytes = [p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$ (p
ofs p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0xFF000000) p -> Int -> p
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
                    ,p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$ (p
ofs p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0x00FF0000) p -> Int -> p
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
                    ,p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$ (p
ofs p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0x0000FF00) p -> Int -> p
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
                    ,p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$  p
ofs p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0x000000FF
                    ]
        in case Endianness
endianness of
             Endianness
EndianLittle -> [a] -> [a]
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 (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ do
            let byOffset :: [ImageFileDirectory] -> [ImageFileDirectory]
byOffset = (ImageFileDirectory -> ImageFileDirectory -> Ordering)
-> [ImageFileDirectory] -> [ImageFileDirectory]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word32 -> Word32 -> Ordering)
-> (ImageFileDirectory -> Word32)
-> ImageFileDirectory
-> ImageFileDirectory
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImageFileDirectory -> Word32
ifdOffset)
                cleansIfds :: [ImageFileDirectory] -> [ImageFileDirectory]
cleansIfds = (ImageFileDirectory -> ImageFileDirectory)
-> [ImageFileDirectory] -> [ImageFileDirectory]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endianness -> ImageFileDirectory -> ImageFileDirectory
cleanImageFileDirectory Endianness
endianness)
            [ImageFileDirectory]
subIfds <- [ImageFileDirectory] -> [ImageFileDirectory]
cleansIfds ([ImageFileDirectory] -> [ImageFileDirectory])
-> ([ImageFileDirectory] -> [ImageFileDirectory])
-> [ImageFileDirectory]
-> [ImageFileDirectory]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImageFileDirectory] -> [ImageFileDirectory]
byOffset ([ImageFileDirectory] -> [ImageFileDirectory])
-> Get [ImageFileDirectory] -> Get [ImageFileDirectory]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endianness -> Get [ImageFileDirectory]
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness
            [ImageFileDirectory]
cleaned <- Endianness
-> Int -> [ImageFileDirectory] -> Get [ImageFileDirectory]
fetchExtended Endianness
endianness Int
maxi ([ImageFileDirectory] -> Get [ImageFileDirectory])
-> [ImageFileDirectory] -> Get [ImageFileDirectory]
forall a b. (a -> b) -> a -> b
$ (ImageFileDirectory -> ImageFileDirectory -> Ordering)
-> [ImageFileDirectory] -> [ImageFileDirectory]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word32 -> Word32 -> Ordering)
-> (ImageFileDirectory -> Word32)
-> ImageFileDirectory
-> ImageFileDirectory
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImageFileDirectory -> Word32
ifdOffset) [ImageFileDirectory]
subIfds
            ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData) -> ExifData -> Get ExifData
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 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
4 =
         ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ ByteString -> ExifData
ExifUndefined (ByteString -> ExifData) -> Get ByteString -> Get ExifData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Word32 -> Int
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 } =
          ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> ([Word8] -> ExifData) -> [Word8] -> Get ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExifData
ExifUndefined (ByteString -> ExifData)
-> ([Word8] -> ByteString) -> [Word8] -> ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> Get ExifData) -> [Word8] -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdCount ImageFileDirectory
ifd)
              (Word32 -> [Word8]
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 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
4 =
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ ByteString -> ExifData
ExifString (ByteString -> ExifData) -> Get ByteString -> Get ExifData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Word32 -> Int
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 } =
          ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> ([Word8] -> ExifData) -> [Word8] -> Get ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExifData
ExifString (ByteString -> ExifData)
-> ([Word8] -> ByteString) -> [Word8] -> ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> Get ExifData) -> [Word8] -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdCount ImageFileDirectory
ifd)
              (Word32 -> [Word8]
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 } =
          ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> (Vector Word16 -> ExifData) -> Vector Word16 -> Get ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> ExifData
ExifShorts (Vector Word16 -> Get ExifData) -> Vector Word16 -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Int -> [Word16] -> Vector Word16
forall a. Int -> [a] -> Vector a
V.fromListN Int
2 [Word16]
valList
            where high :: Word16
high = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16) -> Word32 -> Word16
forall a b. (a -> b) -> a -> b
$ Word32
ofs Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16
                  low :: Word16
low = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16) -> Word32 -> Word16
forall a b. (a -> b) -> a -> b
$ Word32
ofs Word32 -> Word32 -> Word32
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 (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> ExifData
ExifRational (Word32 -> Word32 -> ExifData)
-> Get Word32 -> Get (Word32 -> ExifData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endianness -> Get Word32
forall a b. BinaryParam a b => a -> Get b
getP Endianness
EndianLittle Get (Word32 -> ExifData) -> Get Word32 -> Get ExifData
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Endianness -> Get Word32
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 (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> ExifData
ExifSignedRational (Int32 -> Int32 -> ExifData)
-> Get Int32 -> Get (Int32 -> ExifData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endianness -> Get Int32
forall a b. BinaryParam a b => a -> Get b
getP Endianness
EndianLittle Get (Int32 -> ExifData) -> Get Int32 -> Get ExifData
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Endianness -> Get Int32
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 } =
          ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> (Word32 -> ExifData) -> Word32 -> Get ExifData
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 -> Get ExifData) -> Word32 -> Get ExifData
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 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
2 =
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Vector Word16 -> ExifData
ExifShorts (Vector Word16 -> ExifData) -> Get (Vector Word16) -> Get ExifData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Get Word16 -> Get (Vector Word16)
forall {m :: * -> *} {a} {a}.
(Monad m, Integral a) =>
a -> m a -> m (Vector a)
getVec Word32
count Get Word16
forall a. BinaryParam Endianness a => Get a
getE
      fetcher ImageFileDirectory { ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeLong, ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1 } =
          ExifData -> Get ExifData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> (Word32 -> ExifData) -> Word32 -> Get ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ExifData
ExifLong (Word32 -> ExifData) -> (Word32 -> Word32) -> Word32 -> ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Get ExifData) -> Word32 -> Get ExifData
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 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
1 =
          ImageFileDirectory -> Get ExifData -> Get ExifData
align ImageFileDirectory
ifd (Get ExifData -> Get ExifData) -> Get ExifData -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> ExifData
ExifLongs (Vector Word32 -> ExifData) -> Get (Vector Word32) -> Get ExifData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Get Word32 -> Get (Vector Word32)
forall {m :: * -> *} {a} {a}.
(Monad m, Integral a) =>
a -> m a -> m (Vector a)
getVec Word32
count Get Word32
forall a. BinaryParam Endianness a => Get a
getE
      fetcher ImageFileDirectory
_ = ExifData -> Get ExifData
forall a. a -> Get a
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 (IfdType -> ImageFileDirectory) -> IfdType -> ImageFileDirectory
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> IfdType
ifdType ImageFileDirectory
ifd
  where
    aux :: IfdType -> ImageFileDirectory
aux IfdType
TypeShort = ImageFileDirectory
ifd { ifdOffset = ifdOffset ifd `unsafeShiftR` 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 = (ImageFileDirectory -> Get ImageFileDirectory)
-> [ImageFileDirectory] -> Get [ImageFileDirectory]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ImageFileDirectory -> Get ImageFileDirectory)
 -> [ImageFileDirectory] -> Get [ImageFileDirectory])
-> (ImageFileDirectory -> Get ImageFileDirectory)
-> [ImageFileDirectory]
-> Get [ImageFileDirectory]
forall a b. (a -> b) -> a -> b
$ \ImageFileDirectory
ifd -> do
  ExifData
v <- (Endianness, Int, ImageFileDirectory) -> Get ExifData
forall a b. BinaryParam a b => a -> Get b
getP (Endianness
endian, Int
maxi, ImageFileDirectory
ifd)
  ImageFileDirectory -> Get ImageFileDirectory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageFileDirectory -> Get ImageFileDirectory)
-> ImageFileDirectory -> Get ImageFileDirectory
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory
ifd { ifdExtended = 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 = (ImageFileDirectory -> ImageFileDirectory -> Ordering)
-> [ImageFileDirectory] -> [ImageFileDirectory]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ImageFileDirectory -> ImageFileDirectory -> Ordering
comparer where
  comparer :: ImageFileDirectory -> ImageFileDirectory -> Ordering
comparer ImageFileDirectory
a ImageFileDirectory
b = Word16 -> Word16 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word16
t1 Word16
t2 where
    t1 :: Word16
t1 = ExifTag -> Word16
word16OfTag (ExifTag -> Word16) -> ExifTag -> Word16
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
a
    t2 :: Word16
t2 = ExifTag -> Word16
word16OfTag (ExifTag -> Word16) -> ExifTag -> Word16
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 = (Word32 -> ImageFileDirectory -> (Word32, ImageFileDirectory))
-> Word32 -> [ImageFileDirectory] -> (Word32, [ImageFileDirectory])
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 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [ImageFileDirectory] -> Int
forall a. [a] -> Int
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
                     Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
ifdElementCount Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
ifdSize
                     Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
ifdCountSize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
nextOffsetSize

        paddedSize :: ByteString -> b
paddedSize ByteString
blob = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
blobLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding where
          blobLength :: Int
blobLength = ByteString -> Int
B.length ByteString
blob
          padding :: Int
padding = if Int -> Bool
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 = ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifUndefined ByteString
b }) =
            (Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ ByteString -> Word32
forall {b}. Num b => ByteString -> b
paddedSize ByteString
b, ImageFileDirectory
ifd { ifdOffset = ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifString ByteString
b }) =
            (Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ ByteString -> Word32
forall {b}. Num b => ByteString -> b
paddedSize ByteString
b, ImageFileDirectory
ifd { ifdOffset = ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifLongs Vector Word32
v })
            | Vector Word32 -> Int
forall a. Vector a -> Int
V.length Vector Word32
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = ( Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
V.length Vector Word32
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
                               , ImageFileDirectory
ifd { ifdOffset = ix } )
        updater Word32
ix ifd :: ImageFileDirectory
ifd@(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifShorts Vector Word16
v })
            | Vector Word16 -> Int
forall a. Vector a -> Int
V.length Vector Word16
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = ( Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word16 -> Int
forall a. Vector a -> Int
V.length Vector Word16
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
                             , ImageFileDirectory
ifd { ifdOffset = 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
    TiffHeader -> Put
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) = (Word32 -> [ImageFileDirectory] -> (Word32, [ImageFileDirectory]))
-> Word32
-> [[ImageFileDirectory]]
-> (Word32, [[ImageFileDirectory]])
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 ([ImageFileDirectory] -> (Word32, [ImageFileDirectory]))
-> [ImageFileDirectory] -> (Word32, [ImageFileDirectory])
forall a b. (a -> b) -> a -> b
$ [ImageFileDirectory] -> [ImageFileDirectory]
orderIfdByTag [ImageFileDirectory]
ifd)
            (TiffHeader -> Word32
hdrOffset TiffHeader
hdr)
            [[ImageFileDirectory]]
ifds
    [[ImageFileDirectory]] -> ([ImageFileDirectory] -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[ImageFileDirectory]]
offseted (([ImageFileDirectory] -> Put) -> Put)
-> ([ImageFileDirectory] -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \[ImageFileDirectory]
list -> do
        Endianness -> [ImageFileDirectory] -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness [ImageFileDirectory]
list
        (ImageFileDirectory -> Put) -> [ImageFileDirectory] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ImageFileDirectory
field -> (Endianness, Int, ImageFileDirectory) -> ExifData -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP (Endianness
endianness, (Int
0::Int), ImageFileDirectory
field) (ExifData -> Put) -> ExifData -> Put
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 <- Get TiffHeader
forall t. Binary t => Get t
get
    Int64
readed <- Get Int64
bytesRead
    Int -> Get ()
skip (Int -> Get ()) -> (Int64 -> Int) -> Int64 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Get ()) -> Int64 -> Get ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TiffHeader -> Word32
hdrOffset TiffHeader
hdr) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
readed
    let endian :: Endianness
endian = TiffHeader -> Endianness
hdrEndianness TiffHeader
hdr
        byOffset :: [ImageFileDirectory] -> [ImageFileDirectory]
byOffset = (ImageFileDirectory -> ImageFileDirectory -> Ordering)
-> [ImageFileDirectory] -> [ImageFileDirectory]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word32 -> Word32 -> Ordering)
-> (ImageFileDirectory -> Word32)
-> ImageFileDirectory
-> ImageFileDirectory
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImageFileDirectory -> Word32
ifdOffset)
        cleanIfds :: [ImageFileDirectory] -> [ImageFileDirectory]
cleanIfds = (ImageFileDirectory -> ImageFileDirectory)
-> [ImageFileDirectory] -> [ImageFileDirectory]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endianness -> ImageFileDirectory -> ImageFileDirectory
cleanImageFileDirectory Endianness
endian)

    [ImageFileDirectory]
ifd <-  [ImageFileDirectory] -> [ImageFileDirectory]
cleanIfds ([ImageFileDirectory] -> [ImageFileDirectory])
-> ([ImageFileDirectory] -> [ImageFileDirectory])
-> [ImageFileDirectory]
-> [ImageFileDirectory]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImageFileDirectory] -> [ImageFileDirectory]
byOffset ([ImageFileDirectory] -> [ImageFileDirectory])
-> Get [ImageFileDirectory] -> Get [ImageFileDirectory]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endianness -> Get [ImageFileDirectory]
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
    (TiffHeader, [[ImageFileDirectory]])
-> Get (TiffHeader, [[ImageFileDirectory]])
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (TiffHeader
hdr, [[ImageFileDirectory]
cleaned])

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

unpackSampleFormat :: Word32 -> Get TiffSampleFormat
unpackSampleFormat :: Word32 -> Get TiffSampleFormat
unpackSampleFormat Word32
v = case Word32
v of
  Word32
1 -> TiffSampleFormat -> Get TiffSampleFormat
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleUint
  Word32
2 -> TiffSampleFormat -> Get TiffSampleFormat
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleInt
  Word32
3 -> TiffSampleFormat -> Get TiffSampleFormat
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleFloat
  Word32
4 -> TiffSampleFormat -> Get TiffSampleFormat
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffSampleFormat
TiffSampleUnknown
  Word32
vv -> String -> Get TiffSampleFormat
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get TiffSampleFormat) -> String -> Get TiffSampleFormat
forall a b. (a -> b) -> a -> b
$ String
"Undefined data format (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
vv String -> ShowS
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 (ImageFileDirectory -> ImageFileDirectory -> Bool
(ImageFileDirectory -> ImageFileDirectory -> Bool)
-> (ImageFileDirectory -> ImageFileDirectory -> Bool)
-> Eq ImageFileDirectory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageFileDirectory -> ImageFileDirectory -> Bool
== :: ImageFileDirectory -> ImageFileDirectory -> Bool
$c/= :: ImageFileDirectory -> ImageFileDirectory -> Bool
/= :: ImageFileDirectory -> ImageFileDirectory -> Bool
Eq, Int -> ImageFileDirectory -> ShowS
[ImageFileDirectory] -> ShowS
ImageFileDirectory -> String
(Int -> ImageFileDirectory -> ShowS)
-> (ImageFileDirectory -> String)
-> ([ImageFileDirectory] -> ShowS)
-> Show ImageFileDirectory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageFileDirectory -> ShowS
showsPrec :: Int -> ImageFileDirectory -> ShowS
$cshow :: ImageFileDirectory -> String
show :: ImageFileDirectory -> String
$cshowList :: [ImageFileDirectory] -> ShowS
showList :: [ImageFileDirectory] -> ShowS
Show, (forall x. ImageFileDirectory -> Rep ImageFileDirectory x)
-> (forall x. Rep ImageFileDirectory x -> ImageFileDirectory)
-> Generic ImageFileDirectory
forall x. Rep ImageFileDirectory x -> ImageFileDirectory
forall x. ImageFileDirectory -> Rep ImageFileDirectory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImageFileDirectory -> Rep ImageFileDirectory x
from :: forall x. ImageFileDirectory -> Rep ImageFileDirectory x
$cto :: forall x. Rep ImageFileDirectory x -> ImageFileDirectory
to :: forall x. Rep ImageFileDirectory x -> ImageFileDirectory
Generic)
instance NFData ImageFileDirectory

instance BinaryParam Endianness ImageFileDirectory where
  getP :: Endianness -> Get ImageFileDirectory
getP Endianness
endianness =
    ExifTag
-> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
ImageFileDirectory (ExifTag
 -> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory)
-> Get ExifTag
-> Get
     (IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExifTag
forall a. BinaryParam Endianness a => Get a
getE Get (IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory)
-> Get IfdType
-> Get (Word32 -> Word32 -> ExifData -> ImageFileDirectory)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get IfdType
forall a. BinaryParam Endianness a => Get a
getE Get (Word32 -> Word32 -> ExifData -> ImageFileDirectory)
-> Get Word32 -> Get (Word32 -> ExifData -> ImageFileDirectory)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
forall a. BinaryParam Endianness a => Get a
getE Get (Word32 -> ExifData -> ImageFileDirectory)
-> Get Word32 -> Get (ExifData -> ImageFileDirectory)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
forall a. BinaryParam Endianness a => Get a
getE
                       Get (ExifData -> ImageFileDirectory)
-> Get ExifData -> Get ImageFileDirectory
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExifData -> Get ExifData
forall a. a -> Get a
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 = Endianness -> Get a
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 = Endianness -> a -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness
    ExifTag -> Put
forall a. BinaryParam Endianness a => a -> Put
putE (ExifTag -> Put) -> ExifTag -> Put
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
ifd
    IfdType -> Put
forall a. BinaryParam Endianness a => a -> Put
putE (IfdType -> Put) -> IfdType -> Put
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> IfdType
ifdType ImageFileDirectory
ifd
    Word32 -> Put
forall a. BinaryParam Endianness a => a -> Put
putE (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdCount ImageFileDirectory
ifd
    Word32 -> Put
forall a. BinaryParam Endianness a => a -> Put
putE (Word32 -> Put) -> Word32 -> Put
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 <- Endianness -> Get Word16
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness :: Get Word16
    [ImageFileDirectory]
rez <- Int -> Get ImageFileDirectory -> Get [ImageFileDirectory]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
count) (Get ImageFileDirectory -> Get [ImageFileDirectory])
-> Get ImageFileDirectory -> Get [ImageFileDirectory]
forall a b. (a -> b) -> a -> b
$ Endianness -> Get ImageFileDirectory
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness
    Word32
_ <- Endianness -> Get Word32
forall a b. BinaryParam a b => a -> Get b
getP Endianness
endianness :: Get Word32
    [ImageFileDirectory] -> Get [ImageFileDirectory]
forall a. a -> Get a
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 = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [ImageFileDirectory] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ImageFileDirectory]
lst :: Word16
    Endianness -> Word16 -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness Word16
count
    (ImageFileDirectory -> Put) -> [ImageFileDirectory] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Endianness -> ImageFileDirectory -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP Endianness
endianness) [ImageFileDirectory]
lst
    Endianness -> Word32 -> Put
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 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffMonochromeWhite0
  Word32
1 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffMonochrome
  Word32
2 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffRGB
  Word32
3 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffPaleted
  Word32
4 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffTransparencyMask
  Word32
5 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffCMYK
  Word32
6 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffYCbCr
  Word32
8 -> TiffColorspace -> Get TiffColorspace
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffColorspace
TiffCIELab
  Word32
vv -> String -> Get TiffColorspace
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get TiffColorspace) -> String -> Get TiffColorspace
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized color space " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
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 -> TiffCompression -> Get TiffCompression
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionNone
  Word32
1 -> TiffCompression -> Get TiffCompression
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionNone
  Word32
2 -> TiffCompression -> Get TiffCompression
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionModifiedRLE
  Word32
5 -> TiffCompression -> Get TiffCompression
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionLZW
  Word32
6 -> TiffCompression -> Get TiffCompression
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionJPEG
  Word32
32773 -> TiffCompression -> Get TiffCompression
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TiffCompression
CompressionPackBit
  Word32
vv -> String -> Get TiffCompression
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get TiffCompression) -> String -> Get TiffCompression
forall a b. (a -> b) -> a -> b
$ String
"Unknown compression scheme " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
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