ImageSize: determine PNG size without decoding the image.

As with the earlier JPEG change: JuicyPixels' decodeImageWithMetadata
fully decodes paletted PNGs before returning any metadata (other PNG
color types are decoded lazily, but still allocate).  Instead, read
the dimensions from the IHDR chunk and the resolution from the pHYs
chunk, using the same unit conversion as JuicyPixels, so results are
unchanged.  If the header scan fails, we still fall back to the full
decoder.

Co-Authored-By: Claude <noreply@anthropic.com>

src/Text/Pandoc/ImageSize.hs

@@ -161,7 +161,11 @@ findSvgTag img = case B.elemIndex '<' img of
 imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize
 imageSize opts img = checkDpi <$>
   case imageType img of
-       Just Png  -> getSize img
+       Just Png  -> case pngSize img of
+                      Just sz -> Right sz
+                      -- fall back to the full decoder if the header
+                      -- scan fails:
+                      Nothing -> getSize img
        Just Gif  -> getSize img
        Just Jpeg -> case jpegSize img of
                       Just sz -> Right sz
@@ -388,6 +392,53 @@ safeDecompress bs = fmap B.concat $
     (Zlib.decompressST Zlib.zlibFormat Zlib.defaultDecompressParams)
     (BL.fromStrict bs)
 
+-- | Extract PNG size from the IHDR and pHYs chunks, without
+-- decoding any image data.  (For paletted PNGs, JuicyPixels decodes
+-- the whole image before returning metadata.)
+pngSize :: ByteString -> Maybe ImageSize
+pngSize img =
+  case runGetOrFail pPngSize (BL.fromStrict img) of
+    Left _ -> Nothing
+    Right (_, _, sz) -> Just sz
+ where
+  pPngSize = do
+    skip 8  -- signature
+    -- the IHDR chunk always comes first:
+    ihdrLen <- getWord32be
+    ihdr <- getByteString 4
+    when (ihdr /= "IHDR" || ihdrLen < 13) $ fail "IHDR chunk not found"
+    w <- getWord32be
+    h <- getWord32be
+    skip (fromIntegral ihdrLen - 8 + 4)  -- rest of chunk and CRC
+    (dx, dy) <- findPhys
+    return ImageSize{ pxX = toInteger w, pxY = toInteger h
+                    , dpiX = dx, dpiY = dy }
+  -- scan the following chunks for pHYs:
+  findPhys = do
+    done <- isEmpty
+    if done
+       then return (72, 72)
+       else do
+         len <- getWord32be
+         typ <- getByteString 4
+         case typ of
+           "pHYs" -> do
+             ppuX <- getWord32be
+             ppuY <- getWord32be
+             unit <- getWord8
+             return $ if unit == 1  -- pixels per meter
+                         then (dpmToDpi (toInteger ppuX),
+                               dpmToDpi (toInteger ppuY))
+                         else (72, 72)
+           "IDAT" -> return (72, 72)  -- pHYs must precede image data
+           "IEND" -> return (72, 72)
+           _ -> skip (fromIntegral len + 4) *> findPhys
+
+-- | Convert dots per meter to dots per inch, using the same integer
+-- arithmetic as JuicyPixels for consistency.
+dpmToDpi :: Integer -> Integer
+dpmToDpi z = z * 254 `div` 10000
+
 -- | Extract JPEG size from the header, without decoding any image
 -- data.  Scans the marker segments preceding the entropy-coded data
 -- for a start-of-frame marker (which gives the dimensions in pixels)

test/Tests/ImageSize.hs

@@ -52,6 +52,23 @@ jpegBare, jpegApp0 :: B.ByteString
 jpegBare = B.pack [0xff, 0xd8, 0xff, 0xdb] <> "rest"
 jpegApp0 = B.pack [0xff, 0xd8, 0xff, 0xe0] <> "rest"
 
+-- | A PNG chunk with the given type and body (and a dummy CRC).
+pngChunk :: B.ByteString -> B.ByteString -> B.ByteString
+pngChunk name body = be32 (B.length body) <> name <> body <> B.replicate 4 0
+
+-- | A PNG header with the given extra chunks after IHDR (and no
+-- image data).
+pngFile :: [B.ByteString] -> Int -> Int -> B.ByteString
+pngFile chunks w h = B.concat $
+  [ "\x89PNG\r\n\x1a\n"
+  , pngChunk "IHDR" (be32 w <> be32 h <> B.pack [8, 3, 0, 0, 0]) ]
+  <> chunks
+
+-- | A pHYs chunk with the given unit (1 = pixels per meter) and
+-- pixel densities.
+physChunk :: Word8 -> Int -> Int -> B.ByteString
+physChunk unit x y = pngChunk "pHYs" (be32 x <> be32 y <> B.pack [unit])
+
 -- | A JPEG marker segment with the given marker and body.
 jpegSeg :: Word8 -> B.ByteString -> B.ByteString
 jpegSeg m body = B.pack [0xff, m] <> be16 (B.length body + 2) <> body
@@ -227,6 +244,22 @@ tests =
       , testCase "tkhd box" $
           imageSize def avisTkhd @?= Right (ImageSize 640 480 72 72)
       ]
+    , testGroup "png"  -- headers without image data, so these only
+                       -- succeed if no decoding is attempted
+      [ testCase "no pHYs chunk" $
+          imageSize def (pngFile [] 640 480)
+            @?= Right (ImageSize 640 480 72 72)
+      , testCase "pHYs in pixels per meter" $
+          imageSize def (pngFile [physChunk 1 3937 3937] 640 480)
+            @?= Right (ImageSize 640 480 99 99)
+      , testCase "pHYs with unknown unit" $
+          imageSize def (pngFile [physChunk 0 4 3] 640 480)
+            @?= Right (ImageSize 640 480 72 72)
+      , testCase "pHYs after another chunk" $
+          imageSize def (pngFile [ pngChunk "tEXt" "k\0v"
+                                 , physChunk 1 3937 3937 ] 640 480)
+            @?= Right (ImageSize 640 480 99 99)
+      ]
     , testGroup "jpeg"  -- headers without image data, so these only
                         -- succeed if no decoding is attempted
       [ testCase "jfif dpi" $