{-# 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
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"
class BinaryParam a b where
getP :: a -> Get b
putP :: a -> b -> Put
data =
{ 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
| PlanarConfigSeparate
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
| CompressionModifiedRLE
| CompressionLZW
| CompressionJPEG
| CompressionPackBit
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
| PredictorHorizontalDifferencing
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
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 { 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 }
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
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
, ImageFileDirectory -> IfdType
ifdType :: !IfdType
, 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
| TiffMonochrome
| TiffRGB
| TiffPaleted
| TiffTransparencyMask
| TiffCMYK
| TiffYCbCr
| TiffCIELab
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
=
|
|
codeOfExtraSample :: ExtraSample -> Word16
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