aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/ImageSize.hs
blob: d57f66da5f4e54a298577de0a36c85e044eab80a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, CPP #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-
  Copyright (C) 2011-2018 John MacFarlane <jgm@berkeley.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful, but WITHOUT
    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
    more details.

    You should have received a copy of the GNU General Public License along
    with this program; if not, write to the Free Software Foundation, Inc., 59
    Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- |
Module      : Text.Pandoc.ImageSize
Copyright   : Copyright (C) 2011-2018 John MacFarlane
License     : GNU GPL, version 2 or above

Maintainer  : John MacFarlane <jgm@berkeley.edu>
Stability   : alpha
Portability : portable

Functions for determining the size of a PNG, JPEG, or GIF image.
-}
module Text.Pandoc.ImageSize ( ImageType(..)
                             , imageType
                             , imageSize
                             , sizeInPixels
                             , sizeInPoints
                             , desiredSizeInPoints
                             , Dimension(..)
                             , Direction(..)
                             , dimension
                             , lengthToDim
                             , scaleDimension
                             , inInch
                             , inPixel
                             , inPoints
                             , inEm
                             , numUnit
                             , showInInch
                             , showInPixel
                             , showFl
                             ) where
import Prelude
import Data.ByteString (ByteString, unpack)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (isDigit)
import Control.Monad
import Data.Bits
import Data.Binary
import Data.Binary.Get
import Text.Pandoc.Shared (safeRead)
import Data.Default (Default)
import Numeric (showFFloat)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import qualified Text.Pandoc.UTF8 as UTF8
import qualified Text.XML.Light as Xml
import qualified Data.Map as M
import Control.Monad.Except
import Data.Maybe (fromMaybe)

-- quick and dirty functions to get image sizes
-- algorithms borrowed from wwwis.pl

data ImageType = Png | Gif | Jpeg | Svg | Pdf | Eps | Emf deriving Show
data Direction = Width | Height
instance Show Direction where
  show Width  = "width"
  show Height = "height"

data Dimension = Pixel Integer
               | Centimeter Double
               | Millimeter Double
               | Inch Double
               | Percent Double
               | Em Double
               deriving Eq

instance Show Dimension where
  show (Pixel a)      = show   a ++ "px"
  show (Centimeter a) = showFl a ++ "cm"
  show (Millimeter a) = showFl a ++ "mm"
  show (Inch a)       = showFl a ++ "in"
  show (Percent a)    = show   a ++ "%"
  show (Em a)         = showFl a ++ "em"

data ImageSize = ImageSize{
                     pxX   :: Integer
                   , pxY   :: Integer
                   , dpiX  :: Integer
                   , dpiY  :: Integer
                   } deriving (Read, Show, Eq)
instance Default ImageSize where
  def = ImageSize 300 200 72 72

showFl :: (RealFloat a) => a -> String
showFl a = removeExtra0s $ showFFloat (Just 5) a ""

removeExtra0s :: String -> String
removeExtra0s s =
  case dropWhile (=='0') $ reverse s of
       '.':xs -> reverse xs
       xs     -> reverse xs

imageType :: ByteString -> Maybe ImageType
imageType img = case B.take 4 img of
                     "\x89\x50\x4e\x47" -> return Png
                     "\x47\x49\x46\x38" -> return Gif
                     "\xff\xd8\xff\xe0" -> return Jpeg  -- JFIF
                     "\xff\xd8\xff\xe1" -> return Jpeg  -- Exif
                     "%PDF"             -> return Pdf
                     "<svg"             -> return Svg
                     "<?xm"
                       | findSvgTag img
                                        -> return Svg
                     "%!PS"
                       |  B.take 4 (B.drop 1 $ B.dropWhile (/=' ') img) == "EPSF"
                                        -> return Eps
                     "\x01\x00\x00\x00"
                       | B.take 4 (B.drop 40 img) == " EMF"
                                        -> return Emf
                     _                  -> mzero

findSvgTag :: ByteString -> Bool
findSvgTag img = "<svg" `B.isInfixOf` img || "<SVG" `B.isInfixOf` img

imageSize :: WriterOptions -> ByteString -> Either String ImageSize
imageSize opts img =
  case imageType img of
       Just Png  -> mbToEither "could not determine PNG size" $ pngSize img
       Just Gif  -> mbToEither "could not determine GIF size" $ gifSize img
       Just Jpeg -> jpegSize img
       Just Svg  -> mbToEither "could not determine SVG size" $ svgSize opts img
       Just Eps  -> mbToEither "could not determine EPS size" $ epsSize img
       Just Pdf  -> mbToEither "could not determine PDF size" $ pdfSize img
       Just Emf  -> mbToEither "could not determine EMF size" $ emfSize img
       Nothing   -> Left "could not determine image type"
  where mbToEither msg Nothing  = Left msg
        mbToEither _   (Just x) = Right x

defaultSize :: (Integer, Integer)
defaultSize = (72, 72)

sizeInPixels :: ImageSize -> (Integer, Integer)
sizeInPixels s = (pxX s, pxY s)

-- | Calculate (height, width) in points using the image file's dpi metadata,
-- using 72 Points == 1 Inch.
sizeInPoints :: ImageSize -> (Double, Double)
sizeInPoints s = (pxXf * 72 / dpiXf, pxYf * 72 / dpiYf)
  where
    pxXf  = fromIntegral $ pxX s
    pxYf  = fromIntegral $ pxY s
    dpiXf = fromIntegral $ dpiX s
    dpiYf = fromIntegral $ dpiY s

-- | Calculate (height, width) in points, considering the desired dimensions in the
-- attribute, while falling back on the image file's dpi metadata if no dimensions
-- are specified in the attribute (or only dimensions in percentages).
desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints opts attr s =
  case (getDim Width, getDim Height) of
    (Just w, Just h)   -> (w, h)
    (Just w, Nothing)  -> (w, w / ratio)
    (Nothing, Just h)  -> (h * ratio, h)
    (Nothing, Nothing) -> sizeInPoints s
  where
    ratio = fromIntegral (pxX s) / fromIntegral (pxY s)
    getDim dir = case dimension dir attr of
                   Just (Percent _) -> Nothing
                   Just dim         -> Just $ inPoints opts dim
                   Nothing          -> Nothing

inPoints :: WriterOptions -> Dimension -> Double
inPoints opts dim = 72 * inInch opts dim

inEm :: WriterOptions -> Dimension -> Double
inEm opts dim = (64/11) * inInch opts dim

inInch :: WriterOptions -> Dimension -> Double
inInch opts dim =
  case dim of
    (Pixel a)      -> fromIntegral a / fromIntegral (writerDpi opts)
    (Centimeter a) -> a * 0.3937007874
    (Millimeter a) -> a * 0.03937007874
    (Inch a)       -> a
    (Percent _)    -> 0
    (Em a)         -> a * (11/64)

inPixel :: WriterOptions -> Dimension -> Integer
inPixel opts dim =
  case dim of
    (Pixel a)      -> a
    (Centimeter a) -> floor $ dpi * a * 0.3937007874 :: Integer
    (Millimeter a) -> floor $ dpi * a * 0.03937007874 :: Integer
    (Inch a)       -> floor $ dpi * a :: Integer
    (Percent _)    -> 0
    (Em a)         -> floor $ dpi * a * (11/64) :: Integer
  where
    dpi = fromIntegral $ writerDpi opts

-- | Convert a Dimension to a String denoting its equivalent in inches, for example "2.00000".
-- Note: Dimensions in percentages are converted to the empty string.
showInInch :: WriterOptions -> Dimension -> String
showInInch _ (Percent _) = ""
showInInch opts dim = showFl $ inInch opts dim

-- | Convert a Dimension to a String denoting its equivalent in pixels, for example "600".
-- Note: Dimensions in percentages are converted to the empty string.
showInPixel :: WriterOptions -> Dimension -> String
showInPixel _ (Percent _) = ""
showInPixel opts dim = show $ inPixel opts dim

-- | Maybe split a string into a leading number and trailing unit, e.g. "3cm" to Just (3.0, "cm")
numUnit :: String -> Maybe (Double, String)
numUnit s =
  let (nums, unit) = span (\c -> isDigit c || ('.'==c)) s
  in  case safeRead nums of
        Just n  -> Just (n, unit)
        Nothing -> Nothing

-- | Scale a dimension by a factor.
scaleDimension :: Double -> Dimension -> Dimension
scaleDimension factor dim =
  case dim of
        Pixel x      -> Pixel (round $ factor * fromIntegral x)
        Centimeter x -> Centimeter (factor * x)
        Millimeter x -> Millimeter (factor * x)
        Inch x       -> Inch (factor * x)
        Percent x    -> Percent (factor * x)
        Em x         -> Em (factor * x)

-- | Read a Dimension from an Attr attribute.
-- `dimension Width attr` might return `Just (Pixel 3)` or for example `Just (Centimeter 2.0)`, etc.
dimension :: Direction -> Attr -> Maybe Dimension
dimension dir (_, _, kvs) =
  case dir of
    Width  -> extractDim "width"
    Height -> extractDim "height"
  where
    extractDim key = lookup key kvs >>= lengthToDim

lengthToDim :: String -> Maybe Dimension
lengthToDim s = numUnit s >>= uncurry toDim
  where
    toDim a "cm"   = Just $ Centimeter a
    toDim a "mm"   = Just $ Millimeter a
    toDim a "in"   = Just $ Inch a
    toDim a "inch" = Just $ Inch a
    toDim a "%"    = Just $ Percent a
    toDim a "px"   = Just $ Pixel (floor a::Integer)
    toDim a ""     = Just $ Pixel (floor a::Integer)
    toDim a "pt"   = Just $ Inch (a / 72)
    toDim a "pc"   = Just $ Inch (a / 6)
    toDim a "em"   = Just $ Em a
    toDim _ _      = Nothing

epsSize :: ByteString -> Maybe ImageSize
epsSize img = do
  let ls = takeWhile ("%" `B.isPrefixOf`) $ B.lines img
  let ls' = dropWhile (not . ("%%BoundingBox:" `B.isPrefixOf`)) ls
  case ls' of
       []    -> mzero
       (x:_) -> case B.words x of
                     [_, _, _, ux, uy] -> do
                        ux' <- safeRead $ B.unpack ux
                        uy' <- safeRead $ B.unpack uy
                        return ImageSize{
                            pxX  = ux'
                          , pxY  = uy'
                          , dpiX = 72
                          , dpiY = 72 }
                     _ -> mzero

pdfSize :: ByteString -> Maybe ImageSize
pdfSize img =
  case dropWhile (\l -> not (l == "stream" ||
                             "/MediaBox" `B.isPrefixOf` l)) (B.lines img) of
       (x:_)
         | "/MediaBox" `B.isPrefixOf` x
         -> case B.words . B.takeWhile (/=']')
                         . B.drop 1
                         . B.dropWhile (/='[')
                         $ x of
                     [x1, y1, x2, y2] -> do
                        x1' <- safeRead $ B.unpack x1
                        x2' <- safeRead $ B.unpack x2
                        y1' <- safeRead $ B.unpack y1
                        y2' <- safeRead $ B.unpack y2
                        return ImageSize{
                            pxX  = x2' - x1'
                          , pxY  = y2' - y1'
                          , dpiX = 72
                          , dpiY = 72 }
                     _ -> mzero
       _    -> mzero

pngSize :: ByteString -> Maybe ImageSize
pngSize img = do
  let (h, rest) = B.splitAt 8 img
  guard $ h == "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
          h == "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
  let (i, rest') = B.splitAt 4 $ B.drop 4 rest
  guard $ i == "MHDR" || i == "IHDR"
  let (sizes, rest'') = B.splitAt 8 rest'
  (x,y) <- case map fromIntegral $unpack sizes of
                ([w1,w2,w3,w4,h1,h2,h3,h4] :: [Integer]) -> return
                    (shift w1 24 + shift w2 16 + shift w3 8 + w4,
                     shift h1 24 + shift h2 16 + shift h3 8 + h4)
                _ -> Nothing -- "PNG parse error"
  (dpix, dpiy) <- findpHYs rest''
  return ImageSize { pxX  = x, pxY = y, dpiX = dpix, dpiY = dpiy }

findpHYs :: ByteString -> Maybe (Integer, Integer)
findpHYs x
  | B.null x || "IDAT" `B.isPrefixOf` x = return (72,72)
  | "pHYs" `B.isPrefixOf` x =
    case map fromIntegral $ unpack $ B.take 9 $ B.drop 4 x of
         [x1,x2,x3,x4,y1,y2,y3,y4,u] -> do
           let factor = if u == 1 -- dots per meter
                          then \z -> z * 254 `div` 10000
                          else const 72
           return
              ( factor $ shift x1 24 + shift x2 16 + shift x3 8 + x4,
                factor $ shift y1 24 + shift y2 16 + shift y3 8 + y4 )
         _ -> mzero
  | otherwise = findpHYs $ B.drop 1 x  -- read another byte

gifSize :: ByteString -> Maybe ImageSize
gifSize img = do
  let (h, rest) = B.splitAt 6 img
  guard $ h == "GIF87a" || h == "GIF89a"
  case map fromIntegral $ unpack $ B.take 4 rest of
       [w2,w1,h2,h1] -> return ImageSize {
                          pxX  = shift w1 8 + w2,
                          pxY  = shift h1 8 + h2,
                          dpiX = 72,
                          dpiY = 72
                          }
       _             -> Nothing -- "GIF parse error"

svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize opts img = do
  doc <- Xml.parseXMLDoc $ UTF8.toString img
  let dpi = fromIntegral $ writerDpi opts
  let dirToInt dir = do
        dim <- Xml.findAttrBy (== Xml.QName dir Nothing Nothing) doc >>= lengthToDim
        return $ inPixel opts dim
  w <- dirToInt "width"
  h <- dirToInt "height"
  return ImageSize {
    pxX  = w
  , pxY  = h
  , dpiX = dpi
  , dpiY = dpi
  }

emfSize :: ByteString -> Maybe ImageSize
emfSize img =
  let
    parseheader = runGetOrFail $ do
      skip 0x18             -- 0x00
      frameL <- getWord32le -- 0x18  measured in 1/100 of a millimetre
      frameT <- getWord32le -- 0x1C
      frameR <- getWord32le -- 0x20
      frameB <- getWord32le -- 0x24
      skip 0x20             -- 0x28
      deviceX <- getWord32le  -- 0x48 pixels of reference device
      deviceY <- getWord32le  -- 0x4C
      mmX <- getWord32le      -- 0x50 real mm of reference device (always 320*240?)
      mmY <- getWord32le      -- 0x58
      -- end of header
      let
        w = (deviceX * (frameR - frameL)) `quot` (mmX * 100)
        h = (deviceY * (frameB - frameT)) `quot` (mmY * 100)
        dpiW = (deviceX * 254) `quot` (mmX * 10)
        dpiH = (deviceY * 254) `quot` (mmY * 10)
      return $ ImageSize
        { pxX = fromIntegral w
        , pxY = fromIntegral h
        , dpiX = fromIntegral dpiW
        , dpiY = fromIntegral dpiH
        }
  in
    case parseheader . BL.fromStrict $ img of
      Left _ -> Nothing
      Right (_, _, size) -> Just size


jpegSize :: ByteString -> Either String ImageSize
jpegSize img =
  let (hdr, rest) = B.splitAt 4 img
  in if B.length rest < 14
        then Left "unable to determine JPEG size"
        else case hdr of
               "\xff\xd8\xff\xe0" -> jfifSize rest
               "\xff\xd8\xff\xe1" -> exifSize rest
               _                  -> Left "unable to determine JPEG size"

jfifSize :: ByteString -> Either String ImageSize
jfifSize rest =
  case map fromIntegral $ unpack $ B.take 5 $ B.drop 9 rest of
    [dpiDensity,dpix1,dpix2,dpiy1,dpiy2] ->
      let factor = case dpiDensity of
                        1 -> id
                        2 -> \x -> x * 254 `div` 10
                        _ -> const 72
          dpix = factor (shift dpix1 8 + dpix2)
          dpiy = factor (shift dpiy1 8 + dpiy2)
      in case findJfifSize rest of
         Left msg    -> Left msg
         Right (w,h) -> Right ImageSize { pxX = w
                                        , pxY = h
                                        , dpiX = dpix
                                        , dpiY = dpiy }
    _ -> Left "unable to determine JFIF size"

findJfifSize :: ByteString -> Either String (Integer,Integer)
findJfifSize bs =
  let bs' = B.dropWhile (=='\xff') $ B.dropWhile (/='\xff') bs
  in case B.uncons bs' of
       Just (c,bs'') | c >= '\xc0' && c <= '\xc3' ->
         case map fromIntegral $ unpack $ B.take 4 $ B.drop 3 bs'' of
              [h1,h2,w1,w2] -> Right (shift w1 8 + w2, shift h1 8 + h2)
              _             -> Left "JFIF parse error"
       Just (_,bs'') ->
         case map fromIntegral $ unpack $ B.take 2 bs'' of
              [c1,c2] ->
                let len = shift c1 8 + c2
                -- skip variables
                in  findJfifSize $ B.drop len bs''
              _       -> Left "JFIF parse error"
       Nothing -> Left "Did not find JFIF length record"

runGet' :: Get (Either String a) -> BL.ByteString -> Either String a
runGet' p bl =
#if MIN_VERSION_binary(0,7,0)
  case runGetOrFail p bl of
       Left (_,_,msg) -> Left msg
       Right (_,_,x)  -> x
#else
  runGet p bl
#endif


exifSize :: ByteString -> Either String ImageSize
exifSize bs =runGet' header bl
  where bl = BL.fromChunks [bs]
        header = runExceptT $ exifHeader bl
-- NOTE:  It would be nicer to do
-- runGet ((Just <$> exifHeader) <|> return Nothing)
-- which would prevent pandoc from raising an error when an exif header can't
-- be parsed.  But we only get an Alternative instance for Get in binary 0.6,
-- and binary 0.5 ships with ghc 7.6.

exifHeader :: BL.ByteString -> ExceptT String Get ImageSize
exifHeader hdr = do
  _app1DataSize <- lift getWord16be
  exifHdr <- lift getWord32be
  unless (exifHdr == 0x45786966) $ throwError "Did not find exif header"
  zeros <- lift getWord16be
  unless (zeros == 0) $ throwError "Expected zeros after exif header"
  -- beginning of tiff header -- we read whole thing to use
  -- in getting data from offsets:
  let tiffHeader = BL.drop 8 hdr
  byteAlign <- lift getWord16be
  let bigEndian = byteAlign == 0x4d4d
  let (getWord16, getWord32, getWord64) =
        if bigEndian
           then (getWord16be, getWord32be, getWord64be)
           else (getWord16le, getWord32le, getWord64le)
  let getRational = do
        num <- getWord32
        den <- getWord32
        return $ fromIntegral num / fromIntegral den
  tagmark <- lift getWord16
  unless (tagmark == 0x002a) $ throwError "Failed alignment sanity check"
  ifdOffset <- lift getWord32
  lift $ skip (fromIntegral ifdOffset - 8) -- skip to IDF
  numentries <- lift  getWord16
  let ifdEntry :: ExceptT String Get (TagType, DataFormat)
      ifdEntry = do
       tag <- fromMaybe UnknownTagType . flip M.lookup tagTypeTable
                <$> lift getWord16
       dataFormat <- lift getWord16
       numComponents <- lift getWord32
       (fmt, bytesPerComponent) <-
             case dataFormat of
                  1  -> return (UnsignedByte <$> getWord8, 1)
                  2  -> return (AsciiString <$>
                                getLazyByteString
                                (fromIntegral numComponents), 1)
                  3  -> return (UnsignedShort <$> getWord16, 2)
                  4  -> return (UnsignedLong <$> getWord32, 4)
                  5  -> return (UnsignedRational <$> getRational, 8)
                  6  -> return (SignedByte <$> getWord8, 1)
                  7  -> return (Undefined <$> getLazyByteString
                                (fromIntegral numComponents), 1)
                  8  -> return (SignedShort <$> getWord16, 2)
                  9  -> return (SignedLong <$> getWord32, 4)
                  10 -> return (SignedRational <$> getRational, 8)
                  11 -> return (SingleFloat <$> getWord32 {- TODO -}, 4)
                  12 -> return (DoubleFloat <$> getWord64 {- TODO -}, 8)
                  _  -> throwError $ "Unknown data format " ++ show dataFormat
       let totalBytes = fromIntegral $ numComponents * bytesPerComponent
       payload <- if totalBytes <= 4 -- data is right here
                     then lift $ fmt <* skip (4 - totalBytes)
                     else do  -- get data from offset
                          offs <- lift getWord32
                          let bytesAtOffset =
                                 BL.take (fromIntegral totalBytes)
                                 $ BL.drop (fromIntegral offs) tiffHeader
                          case runGet' (Right <$> fmt) bytesAtOffset of
                               Left msg -> throwError msg
                               Right x  -> return x
       return (tag, payload)
  entries <- replicateM (fromIntegral numentries) ifdEntry
  subentries <- case lookup ExifOffset entries of
                      Just (UnsignedLong offset') -> do
                        pos <- lift bytesRead
                        lift $ skip (fromIntegral offset' - (fromIntegral pos - 8))
                        numsubentries <- lift getWord16
                        replicateM (fromIntegral numsubentries) ifdEntry
                      _ -> return []
  let allentries = entries ++ subentries
  (wdth, hght) <- case (lookup ExifImageWidth allentries,
                        lookup ExifImageHeight allentries) of
                       (Just (UnsignedLong w), Just (UnsignedLong h)) ->
                         return (fromIntegral w, fromIntegral h)
                       _ -> return defaultSize
                            -- we return a default width and height when
                            -- the exif header doesn't contain these
  let resfactor = case lookup ResolutionUnit allentries of
                        Just (UnsignedShort 1) -> 100 / 254
                        _ -> 1
  let xres = case lookup XResolution allentries of
                  Just (UnsignedRational x) -> floor (x * resfactor)
                  _ -> 72
  let yres = case lookup YResolution allentries of
                  Just (UnsignedRational y) -> floor (y * resfactor)
                  _ -> 72
  return ImageSize{
                    pxX  = wdth
                  , pxY  = hght
                  , dpiX = xres
                  , dpiY = yres }

data DataFormat = UnsignedByte Word8
                | AsciiString BL.ByteString
                | UnsignedShort Word16
                | UnsignedLong Word32
                | UnsignedRational Rational
                | SignedByte Word8
                | Undefined BL.ByteString
                | SignedShort Word16
                | SignedLong Word32
                | SignedRational Rational
                | SingleFloat Word32
                | DoubleFloat Word64
                deriving (Show)

data TagType = ImageDescription
             | Make
             | Model
             | Orientation
             | XResolution
             | YResolution
             | ResolutionUnit
             | Software
             | DateTime
             | WhitePoint
             | PrimaryChromaticities
             | YCbCrCoefficients
             | YCbCrPositioning
             | ReferenceBlackWhite
             | Copyright
             | ExifOffset
             | ExposureTime
             | FNumber
             | ExposureProgram
             | ISOSpeedRatings
             | ExifVersion
             | DateTimeOriginal
             | DateTimeDigitized
             | ComponentConfiguration
             | CompressedBitsPerPixel
             | ShutterSpeedValue
             | ApertureValue
             | BrightnessValue
             | ExposureBiasValue
             | MaxApertureValue
             | SubjectDistance
             | MeteringMode
             | LightSource
             | Flash
             | FocalLength
             | MakerNote
             | UserComment
             | FlashPixVersion
             | ColorSpace
             | ExifImageWidth
             | ExifImageHeight
             | RelatedSoundFile
             | ExifInteroperabilityOffset
             | FocalPlaneXResolution
             | FocalPlaneYResolution
             | FocalPlaneResolutionUnit
             | SensingMethod
             | FileSource
             | SceneType
             | UnknownTagType
             deriving (Show, Eq, Ord)

tagTypeTable :: M.Map Word16 TagType
tagTypeTable = M.fromList
  [ (0x010e, ImageDescription)
  , (0x010f, Make)
  , (0x0110, Model)
  , (0x0112, Orientation)
  , (0x011a, XResolution)
  , (0x011b, YResolution)
  , (0x0128, ResolutionUnit)
  , (0x0131, Software)
  , (0x0132, DateTime)
  , (0x013e, WhitePoint)
  , (0x013f, PrimaryChromaticities)
  , (0x0211, YCbCrCoefficients)
  , (0x0213, YCbCrPositioning)
  , (0x0214, ReferenceBlackWhite)
  , (0x8298, Copyright)
  , (0x8769, ExifOffset)
  , (0x829a, ExposureTime)
  , (0x829d, FNumber)
  , (0x8822, ExposureProgram)
  , (0x8827, ISOSpeedRatings)
  , (0x9000, ExifVersion)
  , (0x9003, DateTimeOriginal)
  , (0x9004, DateTimeDigitized)
  , (0x9101, ComponentConfiguration)
  , (0x9102, CompressedBitsPerPixel)
  , (0x9201, ShutterSpeedValue)
  , (0x9202, ApertureValue)
  , (0x9203, BrightnessValue)
  , (0x9204, ExposureBiasValue)
  , (0x9205, MaxApertureValue)
  , (0x9206, SubjectDistance)
  , (0x9207, MeteringMode)
  , (0x9208, LightSource)
  , (0x9209, Flash)
  , (0x920a, FocalLength)
  , (0x927c, MakerNote)
  , (0x9286, UserComment)
  , (0xa000, FlashPixVersion)
  , (0xa001, ColorSpace)
  , (0xa002, ExifImageWidth)
  , (0xa003, ExifImageHeight)
  , (0xa004, RelatedSoundFile)
  , (0xa005, ExifInteroperabilityOffset)
  , (0xa20e, FocalPlaneXResolution)
  , (0xa20f, FocalPlaneYResolution)
  , (0xa210, FocalPlaneResolutionUnit)
  , (0xa217, SensingMethod)
  , (0xa300, FileSource)
  , (0xa301, SceneType)
  ]