c3aa90b · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

ImageSize: use JuicyPixels to extract size...

c3aa90bJohn MacFarlane6 years ago

src/Text/Pandoc/ImageSize.hs+8−305

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, CPP #-}

1+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

2{-# LANGUAGE ViewPatterns #-}

3{-# OPTIONS_GHC -fno-warn-type-defaults #-}

4{- |

@@ -32,14 +32,12 @@ module Text.Pandoc.ImageSize ( ImageType(..)

32 , showInPixel

33 , showFl

34 ) where

35−import Data.ByteString (ByteString, unpack)

35+import Data.ByteString (ByteString)

36import qualified Data.ByteString.Char8 as B

37import qualified Data.ByteString.Lazy as BL

38+import Data.Binary.Get

38import Data.Char (isDigit)

39import Data.Char (isDigit)

39import Control.Monad

40import Control.Monad

40−import Data.Bits

41−import Data.Binary

42−import Data.Binary.Get

43import Text.Pandoc.Shared (safeRead)

41import Text.Pandoc.Shared (safeRead)

44import Data.Default (Default)

42import Data.Default (Default)

45import Numeric (showFFloat)

43import Numeric (showFFloat)

@@ -47,12 +45,9 @@ import Text.Pandoc.Definition

47import Text.Pandoc.Options

45import Text.Pandoc.Options

48import qualified Text.Pandoc.UTF8 as UTF8

46import qualified Text.Pandoc.UTF8 as UTF8

49import qualified Text.XML.Light as Xml

47import qualified Text.XML.Light as Xml

50−import qualified Data.Map as M

51import qualified Data.Text as T

48import qualified Data.Text as T

52import qualified Data.Text.Encoding as TE

49import qualified Data.Text.Encoding as TE

53−import Control.Monad.Except

54import Control.Applicative

50import Control.Applicative

55−import Data.Maybe (fromMaybe)

56import qualified Data.Attoparsec.ByteString.Char8 as A

51import qualified Data.Attoparsec.ByteString.Char8 as A

57import qualified Codec.Picture.Metadata as Metadata

52import qualified Codec.Picture.Metadata as Metadata

58import Codec.Picture (decodeImageWithMetadata)

53import Codec.Picture (decodeImageWithMetadata)

@@ -124,9 +119,9 @@ findSvgTag img = "<svg" `B.isInfixOf` img || "<SVG" `B.isInfixOf` img

124imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize

119imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize

125imageSize opts img = checkDpi <$>

120imageSize opts img = checkDpi <$>

126 case imageType img of

121 case imageType img of

127− Just Png -> pngSize img

122+ Just Png -> getSize img

128− Just Gif -> mbToEither "could not determine GIF size" $ gifSize img

123+ Just Gif -> getSize img

129− Just Jpeg -> jpegSize img

124+ Just Jpeg -> getSize img

130 Just Svg -> mbToEither "could not determine SVG size" $ svgSize opts img

125 Just Svg -> mbToEither "could not determine SVG size" $ svgSize opts img

131 Just Eps -> mbToEither "could not determine EPS size" $ epsSize img

126 Just Eps -> mbToEither "could not determine EPS size" $ epsSize img

132 Just Pdf -> mbToEither "could not determine PDF size" $ pdfSize img

127 Just Pdf -> mbToEither "could not determine PDF size" $ pdfSize img

@@ -141,9 +136,6 @@ imageSize opts img = checkDpi <$>

141 , dpiY = if dpiY size == 0 then 72 else dpiY size }

136 , dpiY = if dpiY size == 0 then 72 else dpiY size }

142

137

143

138

144−defaultSize :: (Integer, Integer)

145−defaultSize = (72, 72)

146−

147sizeInPixels :: ImageSize -> (Integer, Integer)

139sizeInPixels :: ImageSize -> (Integer, Integer)

148sizeInPixels s = (pxX s, pxY s)

140sizeInPixels s = (pxX s, pxY s)

149

141

@@ -302,8 +294,8 @@ pPdfSize = do

302 , dpiY = 72 }

294 , dpiY = 72 }

303 ) <|> pPdfSize

295 ) <|> pPdfSize

304

296

305−pngSize :: ByteString -> Either T.Text ImageSize

297+getSize :: ByteString -> Either T.Text ImageSize

306−pngSize img =

298+getSize img =

307 case decodeImageWithMetadata img of

299 case decodeImageWithMetadata img of

308 Left e -> Left (T.pack e)

300 Left e -> Left (T.pack e)

309 Right (_, meta) -> do

301 Right (_, meta) -> do

@@ -319,18 +311,6 @@ pngSize img =

319 , dpiX = fromIntegral dpix

311 , dpiX = fromIntegral dpix

320 , dpiY = fromIntegral dpiy }

312 , dpiY = fromIntegral dpiy }

321

313

322−gifSize :: ByteString -> Maybe ImageSize

323−gifSize img = do

324− let (h, rest) = B.splitAt 6 img

325− guard $ h == "GIF87a" || h == "GIF89a"

326− case map fromIntegral $ unpack $ B.take 4 rest of

327− [w2,w1,h2,h1] -> return ImageSize {

328− pxX = shift w1 8 + w2,

329− pxY = shift h1 8 + h2,

330− dpiX = 72,

331− dpiY = 72

332− }

333− _ -> Nothing -- "GIF parse error"

334

314

335svgSize :: WriterOptions -> ByteString -> Maybe ImageSize

315svgSize :: WriterOptions -> ByteString -> Maybe ImageSize

336svgSize opts img = do

316svgSize opts img = do

@@ -378,280 +358,3 @@ emfSize img =

378 case parseheader . BL.fromStrict $ img of

358 case parseheader . BL.fromStrict $ img of

379 Left _ -> Nothing

359 Left _ -> Nothing

380 Right (_, _, size) -> Just size

360 Right (_, _, size) -> Just size

381−

382−

383−jpegSize :: ByteString -> Either T.Text ImageSize

384−jpegSize img =

385− let (hdr, rest) = B.splitAt 4 img

386− in if B.length rest < 14

387− then Left "unable to determine JPEG size"

388− else case hdr of

389− "\xff\xd8\xff\xe0" -> jfifSize rest

390− "\xff\xd8\xff\xe1" -> exifSize rest

391− _ -> Left "unable to determine JPEG size"

392−

393−jfifSize :: ByteString -> Either T.Text ImageSize

394−jfifSize rest =

395− case map fromIntegral $ unpack $ B.take 5 $ B.drop 9 rest of

396− [dpiDensity,dpix1,dpix2,dpiy1,dpiy2] ->

397− let factor = case dpiDensity of

398− 1 -> id

399− 2 -> \x -> x * 254 `div` 10

400− _ -> const 72

401− dpix = factor (shift dpix1 8 + dpix2)

402− dpiy = factor (shift dpiy1 8 + dpiy2)

403− in case findJfifSize rest of

404− Left msg -> Left msg

405− Right (w,h) -> Right ImageSize { pxX = w

406− , pxY = h

407− , dpiX = dpix

408− , dpiY = dpiy }

409− _ -> Left "unable to determine JFIF size"

410−

411−findJfifSize :: ByteString -> Either T.Text (Integer,Integer)

412−findJfifSize bs =

413− let bs' = B.dropWhile (=='\xff') $ B.dropWhile (/='\xff') bs

414− in case B.uncons bs' of

415− Just (c,bs'') | c >= '\xc0' && c <= '\xc3' ->

416− case map fromIntegral $ unpack $ B.take 4 $ B.drop 3 bs'' of

417− [h1,h2,w1,w2] -> Right (shift w1 8 + w2, shift h1 8 + h2)

418− _ -> Left "JFIF parse error"

419− Just (_,bs'') ->

420− case map fromIntegral $ unpack $ B.take 2 bs'' of

421− [c1,c2] ->

422− let len = shift c1 8 + c2

423− -- skip variables

424− in findJfifSize $ B.drop len bs''

425− _ -> Left "JFIF parse error"

426− Nothing -> Left "Did not find JFIF length record"

427−

428−runGet' :: Get (Either T.Text a) -> BL.ByteString -> Either T.Text a

429−runGet' p bl =

430−#if MIN_VERSION_binary(0,7,0)

431− case runGetOrFail p bl of

432− Left (_,_,msg) -> Left $ T.pack msg

433− Right (_,_,x) -> x

434−#else

435− runGet p bl

436−#endif

437−

438−exifSize :: ByteString -> Either T.Text ImageSize

439−exifSize bs = runGet' header bl

440− where bl = BL.fromChunks [bs]

441− header = runExceptT $ exifHeader bl

442−-- NOTE: It would be nicer to do

443−-- runGet ((Just <$> exifHeader) <|> return Nothing)

444−-- which would prevent pandoc from raising an error when an exif header can't

445−-- be parsed. But we only get an Alternative instance for Get in binary 0.6,

446−-- and binary 0.5 ships with ghc 7.6.

447−

448−exifHeader :: BL.ByteString -> ExceptT T.Text Get ImageSize

449−exifHeader hdr = do

450− _app1DataSize <- lift getWord16be

451− exifHdr <- lift getWord32be

452− unless (exifHdr == 0x45786966) $ throwError "Did not find exif header"

453− zeros <- lift getWord16be

454− unless (zeros == 0) $ throwError "Expected zeros after exif header"

455− -- beginning of tiff header -- we read whole thing to use

456− -- in getting data from offsets:

457− let tiffHeader = BL.drop 8 hdr

458− byteAlign <- lift getWord16be

459− let bigEndian = byteAlign == 0x4d4d

460− let (getWord16, getWord32, getWord64) =

461− if bigEndian

462− then (getWord16be, getWord32be, getWord64be)

463− else (getWord16le, getWord32le, getWord64le)

464− let getRational = do

465− num <- getWord32

466− den <- getWord32

467− return $ fromIntegral num / fromIntegral den

468− tagmark <- lift getWord16

469− unless (tagmark == 0x002a) $ throwError "Failed alignment sanity check"

470− ifdOffset <- lift getWord32

471− lift $ skip (fromIntegral ifdOffset - 8) -- skip to IDF

472− numentries <- lift getWord16

473− let ifdEntry :: ExceptT T.Text Get (TagType, DataFormat)

474− ifdEntry = do

475− tag <- fromMaybe UnknownTagType . flip M.lookup tagTypeTable

476− <$> lift getWord16

477− dataFormat <- lift getWord16

478− numComponents <- lift getWord32

479− (fmt, bytesPerComponent) <-

480− case dataFormat of

481− 1 -> return (UnsignedByte <$> getWord8, 1)

482− 2 -> return (AsciiString <$>

483− getLazyByteString

484− (fromIntegral numComponents), 1)

485− 3 -> return (UnsignedShort <$> getWord16, 2)

486− 4 -> return (UnsignedLong <$> getWord32, 4)

487− 5 -> return (UnsignedRational <$> getRational, 8)

488− 6 -> return (SignedByte <$> getWord8, 1)

489− 7 -> return (Undefined <$> getLazyByteString

490− (fromIntegral numComponents), 1)

491− 8 -> return (SignedShort <$> getWord16, 2)

492− 9 -> return (SignedLong <$> getWord32, 4)

493− 10 -> return (SignedRational <$> getRational, 8)

494− 11 -> return (SingleFloat <$> getWord32 {- TODO -}, 4)

495− 12 -> return (DoubleFloat <$> getWord64 {- TODO -}, 8)

496− _ -> throwError $ "Unknown data format " <> T.pack (show dataFormat)

497− let totalBytes = fromIntegral $ numComponents * bytesPerComponent

498− payload <- if totalBytes <= 4 -- data is right here

499− then lift $ fmt <* skip (4 - totalBytes)

500− else do -- get data from offset

501− offs <- lift getWord32

502− let bytesAtOffset =

503− BL.take (fromIntegral totalBytes)

504− $ BL.drop (fromIntegral offs) tiffHeader

505− case runGet' (Right <$> fmt) bytesAtOffset of

506− Left msg -> throwError msg

507− Right x -> return x

508− return (tag, payload)

509− entries <- replicateM (fromIntegral numentries) ifdEntry

510− subentries <- case lookup ExifOffset entries of

511− Just (UnsignedLong offset') -> do

512− pos <- lift bytesRead

513− lift $ skip (fromIntegral offset' - (fromIntegral pos - 8))

514− numsubentries <- lift getWord16

515− replicateM (fromIntegral numsubentries) ifdEntry

516− _ -> return []

517− let allentries = entries ++ subentries

518− (wdth, hght) <- case (lookup ExifImageWidth allentries,

519− lookup ExifImageHeight allentries) of

520− (Just (UnsignedLong w), Just (UnsignedLong h)) ->

521− return (fromIntegral w, fromIntegral h)

522− _ -> return defaultSize

523− -- we return a default width and height when

524− -- the exif header doesn't contain these

525− let resfactor = case lookup ResolutionUnit allentries of

526− Just (UnsignedShort 1) -> 100 / 254

527− _ -> 1

528− let xres = case lookup XResolution allentries of

529− Just (UnsignedRational x) -> floor (x * resfactor)

530− _ -> 72

531− let yres = case lookup YResolution allentries of

532− Just (UnsignedRational y) -> floor (y * resfactor)

533− _ -> 72

534− return ImageSize{

535− pxX = wdth

536− , pxY = hght

537− , dpiX = xres

538− , dpiY = yres }

539−

540−data DataFormat = UnsignedByte Word8

541− | AsciiString BL.ByteString

542− | UnsignedShort Word16

543− | UnsignedLong Word32

544− | UnsignedRational Rational

545− | SignedByte Word8

546− | Undefined BL.ByteString

547− | SignedShort Word16

548− | SignedLong Word32

549− | SignedRational Rational

550− | SingleFloat Word32

551− | DoubleFloat Word64

552− deriving (Show)

553−

554−data TagType = ImageDescription

555− | Make

556− | Model

557− | Orientation

558− | XResolution

559− | YResolution

560− | ResolutionUnit

561− | Software

562− | DateTime

563− | WhitePoint

564− | PrimaryChromaticities

565− | YCbCrCoefficients

566− | YCbCrPositioning

567− | ReferenceBlackWhite

568− | Copyright

569− | ExifOffset

570− | ExposureTime

571− | FNumber

572− | ExposureProgram

573− | ISOSpeedRatings

574− | ExifVersion

575− | DateTimeOriginal

576− | DateTimeDigitized

577− | ComponentConfiguration

578− | CompressedBitsPerPixel

579− | ShutterSpeedValue

580− | ApertureValue

581− | BrightnessValue

582− | ExposureBiasValue

583− | MaxApertureValue

584− | SubjectDistance

585− | MeteringMode

586− | LightSource

587− | Flash

588− | FocalLength

589− | MakerNote

590− | UserComment

591− | FlashPixVersion

592− | ColorSpace

593− | ExifImageWidth

594− | ExifImageHeight

595− | RelatedSoundFile

596− | ExifInteroperabilityOffset

597− | FocalPlaneXResolution

598− | FocalPlaneYResolution

599− | FocalPlaneResolutionUnit

600− | SensingMethod

601− | FileSource

602− | SceneType

603− | UnknownTagType

604− deriving (Show, Eq, Ord)

605−

606−tagTypeTable :: M.Map Word16 TagType

607−tagTypeTable = M.fromList

608− [ (0x010e, ImageDescription)

609− , (0x010f, Make)

610− , (0x0110, Model)

611− , (0x0112, Orientation)

612− , (0x011a, XResolution)

613− , (0x011b, YResolution)

614− , (0x0128, ResolutionUnit)

615− , (0x0131, Software)

616− , (0x0132, DateTime)

617− , (0x013e, WhitePoint)

618− , (0x013f, PrimaryChromaticities)

619− , (0x0211, YCbCrCoefficients)

620− , (0x0213, YCbCrPositioning)

621− , (0x0214, ReferenceBlackWhite)

622− , (0x8298, Copyright)

623− , (0x8769, ExifOffset)

624− , (0x829a, ExposureTime)

625− , (0x829d, FNumber)

626− , (0x8822, ExposureProgram)

627− , (0x8827, ISOSpeedRatings)

628− , (0x9000, ExifVersion)

629− , (0x9003, DateTimeOriginal)

630− , (0x9004, DateTimeDigitized)

631− , (0x9101, ComponentConfiguration)

632− , (0x9102, CompressedBitsPerPixel)

633− , (0x9201, ShutterSpeedValue)

634− , (0x9202, ApertureValue)

635− , (0x9203, BrightnessValue)

636− , (0x9204, ExposureBiasValue)

637− , (0x9205, MaxApertureValue)

638− , (0x9206, SubjectDistance)

639− , (0x9207, MeteringMode)

640− , (0x9208, LightSource)

641− , (0x9209, Flash)

642− , (0x920a, FocalLength)

643− , (0x927c, MakerNote)

644− , (0x9286, UserComment)

645− , (0xa000, FlashPixVersion)

646− , (0xa001, ColorSpace)

647− , (0xa002, ExifImageWidth)

648− , (0xa003, ExifImageHeight)

649− , (0xa004, RelatedSoundFile)

650− , (0xa005, ExifInteroperabilityOffset)

651− , (0xa20e, FocalPlaneXResolution)

652− , (0xa20f, FocalPlaneYResolution)

653− , (0xa210, FocalPlaneResolutionUnit)

654− , (0xa217, SensingMethod)

655− , (0xa300, FileSource)

656− , (0xa301, SceneType)

657− ]