{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns      #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{- |
Module      : Text.Pandoc.ImageSize
Copyright   : Copyright (C) 2011-2024 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(..)
                             , ImageSize(..)
                             , imageType
                             , imageSize
                             , sizeInPixels
                             , sizeInPoints
                             , desiredSizeInPoints
                             , Dimension(..)
                             , Direction(..)
                             , dimension
                             , lengthToDim
                             , scaleDimension
                             , inInch
                             , inPixel
                             , inPoints
                             , inEm
                             , numUnit
                             , showInInch
                             , showInPixel
                             , showFl
                             ) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import Data.Binary.Get
import Data.Bits ((.&.), shiftR, shiftL)
import Data.Word (Word32)
import Data.Maybe (fromMaybe)
import Data.Char (isDigit)
import Control.Monad
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 Text.Pandoc.XML.Light hiding (Attr)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as TE
import Control.Applicative
import qualified Data.Attoparsec.ByteString as AW
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Codec.Picture.Metadata as Metadata
import Codec.Picture (decodeImageWithMetadata)
import qualified Codec.Compression.Zlib.Internal as Zlib
-- import Debug.Trace

-- quick and dirty functions to get image sizes

data ImageType = Png | Gif | Jpeg | Svg | Pdf | Eps | Emf | Tiff | Webp | Avif
                 deriving (Int -> ImageType -> ShowS
[ImageType] -> ShowS
ImageType -> String
(Int -> ImageType -> ShowS)
-> (ImageType -> String)
-> ([ImageType] -> ShowS)
-> Show ImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageType -> ShowS
showsPrec :: Int -> ImageType -> ShowS
$cshow :: ImageType -> String
show :: ImageType -> String
$cshowList :: [ImageType] -> ShowS
showList :: [ImageType] -> ShowS
Show, ImageType -> ImageType -> Bool
(ImageType -> ImageType -> Bool)
-> (ImageType -> ImageType -> Bool) -> Eq ImageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageType -> ImageType -> Bool
== :: ImageType -> ImageType -> Bool
$c/= :: ImageType -> ImageType -> Bool
/= :: ImageType -> ImageType -> Bool
Eq)
data Direction = Width | Height
instance Show Direction where
  show :: Direction -> String
show Direction
Width  = String
"width"
  show Direction
Height = String
"height"

data Dimension = Pixel Integer
               | Centimeter Double
               | Millimeter Double
               | Inch Double
               | Point Double
               | Pica Double
               | Percent Double
               | Em Double
               deriving Dimension -> Dimension -> Bool
(Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Bool) -> Eq Dimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dimension -> Dimension -> Bool
== :: Dimension -> Dimension -> Bool
$c/= :: Dimension -> Dimension -> Bool
/= :: Dimension -> Dimension -> Bool
Eq

instance Show Dimension where
  show :: Dimension -> String
show (Pixel Integer
a)      = Integer -> String
forall a. Show a => a -> String
show Integer
a              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"px"
  show (Centimeter Double
a) = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cm"
  show (Millimeter Double
a) = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"mm"
  show (Inch Double
a)       = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"in"
  show (Point Double
a)      = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"pt"
  show (Pica Double
a)       = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"pc"
  show (Percent Double
a)    = Double -> String
forall a. Show a => a -> String
show Double
a              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%"
  show (Em Double
a)         = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"em"

data ImageSize = ImageSize{
                     ImageSize -> Integer
pxX   :: Integer
                   , ImageSize -> Integer
pxY   :: Integer
                   , ImageSize -> Integer
dpiX  :: Integer
                   , ImageSize -> Integer
dpiY  :: Integer
                   } deriving (ReadPrec [ImageSize]
ReadPrec ImageSize
Int -> ReadS ImageSize
ReadS [ImageSize]
(Int -> ReadS ImageSize)
-> ReadS [ImageSize]
-> ReadPrec ImageSize
-> ReadPrec [ImageSize]
-> Read ImageSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ImageSize
readsPrec :: Int -> ReadS ImageSize
$creadList :: ReadS [ImageSize]
readList :: ReadS [ImageSize]
$creadPrec :: ReadPrec ImageSize
readPrec :: ReadPrec ImageSize
$creadListPrec :: ReadPrec [ImageSize]
readListPrec :: ReadPrec [ImageSize]
Read, Int -> ImageSize -> ShowS
[ImageSize] -> ShowS
ImageSize -> String
(Int -> ImageSize -> ShowS)
-> (ImageSize -> String)
-> ([ImageSize] -> ShowS)
-> Show ImageSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageSize -> ShowS
showsPrec :: Int -> ImageSize -> ShowS
$cshow :: ImageSize -> String
show :: ImageSize -> String
$cshowList :: [ImageSize] -> ShowS
showList :: [ImageSize] -> ShowS
Show, ImageSize -> ImageSize -> Bool
(ImageSize -> ImageSize -> Bool)
-> (ImageSize -> ImageSize -> Bool) -> Eq ImageSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageSize -> ImageSize -> Bool
== :: ImageSize -> ImageSize -> Bool
$c/= :: ImageSize -> ImageSize -> Bool
/= :: ImageSize -> ImageSize -> Bool
Eq)
instance Default ImageSize where
  def :: ImageSize
def = Integer -> Integer -> Integer -> Integer -> ImageSize
ImageSize Integer
300 Integer
200 Integer
72 Integer
72

showFl :: (RealFloat a) => a -> T.Text
showFl :: forall a. RealFloat a => a -> Text
showFl a
a = Text -> Text
removeExtra0s (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5) a
a String
""

removeExtra0s :: T.Text -> T.Text
removeExtra0s :: Text -> Text
removeExtra0s Text
s = case (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') Text
s of
  (Text -> Maybe (Text, Char)
T.unsnoc -> Just (Text
xs, Char
'.')) -> Text
xs
  Text
xs                           -> Text
xs

dropBOM :: ByteString -> ByteString
dropBOM :: ByteString -> ByteString
dropBOM ByteString
bs =
 if ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs
    then Int -> ByteString -> ByteString
B.drop Int
3 ByteString
bs
    else ByteString
bs

imageType :: ByteString -> Maybe ImageType
imageType :: ByteString -> Maybe ImageType
imageType ByteString
img = case Int -> ByteString -> ByteString
B.take Int
4 ByteString
img of
                     ByteString
"\x89\x50\x4e\x47" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Png
                     ByteString
"\x47\x49\x46\x38" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Gif
                     ByteString
"\x49\x49\x2a\x00" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Tiff
                     ByteString
"\x4D\x4D\x00\x2a" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Tiff
                     ByteString
"\xff\xd8\xff\xdb" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Jpeg  -- JPEG without application segment -- see p.32 in https://www.w3.org/Graphics/JPEG/itu-t81.pdf (and https://gist.github.com/leommoore/f9e57ba2aa4bf197ebc5?permalink_comment_id=3863054#gistcomment-3863054)
                     ByteString
_ | Int -> ByteString -> ByteString
B.take Int
3 ByteString
img ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\xff\xd8\xff"
                          Bool -> Bool -> Bool
&& (let byte4 :: ByteString
byte4 = Int -> ByteString -> ByteString
B.take Int
1 (Int -> ByteString -> ByteString
B.drop Int
3 ByteString
img)
                              in ByteString
byte4 ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString
"\xe0" Bool -> Bool -> Bool
&& ByteString
byte4 ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString
"\xef")  -- JPEG with application segment
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Jpeg
                     ByteString
"%PDF"             -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Pdf
                     ByteString
"<svg"             -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Svg
                     ByteString
"<?xm"
                       | ByteString -> Bool
findSvgTag ByteString
img
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Svg
                     ByteString
"%!PS"
                       |  Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"EPSF"
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Eps
                     ByteString
"\x01\x00\x00\x00"
                       | Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
40 ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
" EMF"
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Emf
                     ByteString
"\xEF\xBB\xBF<" -- BOM before svg
                          -> ByteString -> Maybe ImageType
imageType (Int -> ByteString -> ByteString
B.drop Int
3 ByteString
img)
                     ByteString
"RIFF"
                       | Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
8 ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"WEBP"
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Webp
                     ByteString
_ | Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
4 ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"ftyp"
                          -- require the AVIF brand, so that other
                          -- ISO media (mp4, mov, heic...) is excluded:
                          Bool -> Bool -> Bool
&& (Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
8 ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"avif" Bool -> Bool -> Bool
||
                              Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
8 ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"avis")
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Avif
                     ByteString
_ -> Maybe ImageType
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Check for the presence of an @<svg@ (or @<SVG@) tag, in a
-- single pass over the file.
findSvgTag :: ByteString -> Bool
findSvgTag :: ByteString -> Bool
findSvgTag ByteString
img = case Char -> ByteString -> Maybe Int
B.elemIndex Char
'<' ByteString
img of
  Maybe Int
Nothing -> Bool
False
  Just Int
i ->
    case Int -> ByteString -> ByteString
B.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
img of
      ByteString
rest | ByteString
"svg" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
rest -> Bool
True
           | ByteString
"SVG" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
rest -> Bool
True
           | Bool
otherwise -> ByteString -> Bool
findSvgTag ByteString
rest

imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize
imageSize :: WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
img = ImageSize -> ImageSize
checkDpi (ImageSize -> ImageSize)
-> Either Text ImageSize -> Either Text ImageSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  case ByteString -> Maybe ImageType
imageType ByteString
img of
       Just ImageType
Png  -> case ByteString -> Maybe ImageSize
pngSize ByteString
img of
                      Just ImageSize
sz -> ImageSize -> Either Text ImageSize
forall a b. b -> Either a b
Right ImageSize
sz
                      -- fall back to the full decoder if the header
                      -- scan fails:
                      Maybe ImageSize
Nothing -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Gif  -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Jpeg -> case ByteString -> Maybe ImageSize
jpegSize ByteString
img of
                      Just ImageSize
sz -> ImageSize -> Either Text ImageSize
forall a b. b -> Either a b
Right ImageSize
sz
                      -- fall back to the full decoder if the header
                      -- scan fails:
                      Maybe ImageSize
Nothing -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Tiff -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Svg  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine SVG size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ WriterOptions -> ByteString -> Maybe ImageSize
svgSize WriterOptions
opts ByteString
img
       Just ImageType
Eps  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine EPS size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
epsSize ByteString
img
       Just ImageType
Pdf  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine PDF size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
pdfSize ByteString
img
       Just ImageType
Emf  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine EMF size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
emfSize ByteString
img
       Just ImageType
Webp -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine WebP size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ WriterOptions -> ByteString -> Maybe ImageSize
webpSize WriterOptions
opts ByteString
img
       Just ImageType
Avif -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine AVIF size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ WriterOptions -> ByteString -> Maybe ImageSize
avifSize WriterOptions
opts ByteString
img
       Maybe ImageType
Nothing   -> Text -> Either Text ImageSize
forall a b. a -> Either a b
Left Text
"could not determine image type"
  where mbToEither :: a -> Maybe b -> Either a b
mbToEither a
msg Maybe b
Nothing  = a -> Either a b
forall a b. a -> Either a b
Left a
msg
        mbToEither a
_   (Just b
x) = b -> Either a b
forall a b. b -> Either a b
Right b
x
        -- see #6880, some defective JPEGs may encode dpi 0, so default to 72
        -- if that value is 0 or negative
        checkDpi :: ImageSize -> ImageSize
checkDpi ImageSize
size =
          ImageSize
size{ dpiX = if dpiX size <= 0 then 72 else dpiX size
              , dpiY = if dpiY size <= 0 then 72 else dpiY size }


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

-- | Calculate (height, width) in points using the image file's dpi metadata,
-- using 72 Points == 1 Inch.
sizeInPoints :: ImageSize -> (Double, Double)
sizeInPoints :: ImageSize -> (Double, Double)
sizeInPoints ImageSize
s = (Double
pxXf Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
72 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dpiXf, Double
pxYf Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
72 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dpiYf)
  where
    pxXf :: Double
pxXf  = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
pxX ImageSize
s
    pxYf :: Double
pxYf  = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
pxY ImageSize
s
    dpiXf :: Double
dpiXf = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
dpiX ImageSize
s
    dpiYf :: Double
dpiYf = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
dpiY ImageSize
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 :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts Attr
attr ImageSize
s =
  case (Direction -> Maybe Double
getDim Direction
Width, Direction -> Maybe Double
getDim Direction
Height) of
    (Just Double
w, Just Double
h)   -> (Double
w, Double
h)
    (Just Double
w, Maybe Double
Nothing)  -> (Double
w, Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ratio)
    (Maybe Double
Nothing, Just Double
h)  -> (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ratio, Double
h)
    (Maybe Double
Nothing, Maybe Double
Nothing) -> ImageSize -> (Double, Double)
sizeInPoints ImageSize
s
  where
    ratio :: Double
ratio = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ImageSize -> Integer
pxX ImageSize
s) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ImageSize -> Integer
pxY ImageSize
s)
    getDim :: Direction -> Maybe Double
getDim Direction
dir = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                   Just (Percent Double
_) -> Maybe Double
forall a. Maybe a
Nothing
                   Just Dimension
dim         -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts Dimension
dim
                   Maybe Dimension
Nothing          -> Maybe Double
forall a. Maybe a
Nothing

inPoints :: WriterOptions -> Dimension -> Double
inPoints :: WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts Dimension
dim = Double
72 Double -> Double -> Double
forall a. Num a => a -> a -> a
* WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim

inEm :: WriterOptions -> Dimension -> Double
inEm :: WriterOptions -> Dimension -> Double
inEm WriterOptions
opts Dimension
dim = (Double
64Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
11) Double -> Double -> Double
forall a. Num a => a -> a -> a
* WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim

inInch :: WriterOptions -> Dimension -> Double
inInch :: WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim =
  case Dimension
dim of
    (Pixel Integer
a)      -> Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WriterOptions -> Int
writerDpi WriterOptions
opts)
    (Centimeter Double
a) -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.3937007874
    (Millimeter Double
a) -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.03937007874
    (Inch Double
a)       -> Double
a
    (Point Double
a)      -> (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
72)
    (Pica Double
a)       -> (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
6)
    (Percent Double
_)    -> Double
0
    (Em Double
a)         -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
11Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
64)

inPixel :: WriterOptions -> Dimension -> Integer
inPixel :: WriterOptions -> Dimension -> Integer
inPixel WriterOptions
opts Dimension
dim =
  case Dimension
dim of
    (Pixel Integer
a)      -> Integer
a
    Dimension
_              -> Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
dpi Double -> Double -> Double
forall a. Num a => a -> a -> a
* WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim)
  where
    dpi :: Double
dpi = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerDpi WriterOptions
opts

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

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

-- | Maybe split a string into a leading number and trailing unit, e.g. "3cm" to Just (3.0, "cm").
-- Whitespace between the number and the unit is ignored.
numUnit :: T.Text -> Maybe (Double, T.Text)
numUnit :: Text -> Maybe (Double, Text)
numUnit Text
s =
  let (Text
nums, Text
unit) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| (Char
'.'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c)) Text
s
  in (\Double
n -> (Double
n, Text -> Text
T.stripStart Text
unit)) (Double -> (Double, Text)) -> Maybe Double -> Maybe (Double, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
nums

-- | Scale a dimension by a factor.
scaleDimension :: Double -> Dimension -> Dimension
scaleDimension :: Double -> Dimension -> Dimension
scaleDimension Double
factor Dimension
dim =
  case Dimension
dim of
        Pixel Integer
x      -> Integer -> Dimension
Pixel (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
        Centimeter Double
x -> Double -> Dimension
Centimeter (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Millimeter Double
x -> Double -> Dimension
Millimeter (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Inch Double
x       -> Double -> Dimension
Inch (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Point Double
x      -> Double -> Dimension
Point (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Pica Double
x       -> Double -> Dimension
Pica (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Percent Double
x    -> Double -> Dimension
Percent (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Em Double
x         -> Double -> Dimension
Em (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
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 :: Direction -> Attr -> Maybe Dimension
dimension Direction
dir (Text
_, [Text]
_, [(Text, Text)]
kvs) =
  case Direction
dir of
    Direction
Width  -> Text -> Maybe Dimension
extractDim Text
"width"
    Direction
Height -> Text -> Maybe Dimension
extractDim Text
"height"
  where
    extractDim :: Text -> Maybe Dimension
extractDim Text
key = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Dimension) -> Maybe Dimension
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Dimension
lengthToDim

lengthToDim :: T.Text -> Maybe Dimension
lengthToDim :: Text -> Maybe Dimension
lengthToDim Text
s = Text -> Maybe (Double, Text)
numUnit Text
s Maybe (Double, Text)
-> ((Double, Text) -> Maybe Dimension) -> Maybe Dimension
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Double -> Text -> Maybe Dimension)
-> (Double, Text) -> Maybe Dimension
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Text -> Maybe Dimension
forall {a}. (Eq a, IsString a) => Double -> a -> Maybe Dimension
toDim
  where
    toDim :: Double -> a -> Maybe Dimension
toDim Double
a a
"cm"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Centimeter Double
a
    toDim Double
a a
"mm"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Millimeter Double
a
    toDim Double
a a
"in"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch Double
a
    toDim Double
a a
"inch" = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch Double
a
    toDim Double
a a
"%"    = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Percent Double
a
    toDim Double
a a
"px"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Integer -> Dimension
Pixel (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a::Integer)
    toDim Double
a a
""     = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Integer -> Dimension
Pixel (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a::Integer)
    toDim Double
a a
"pt"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Point Double
a
    toDim Double
a a
"pc"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Pica Double
a
    toDim Double
a a
"em"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Em Double
a
    toDim Double
_ a
_      = Maybe Dimension
forall a. Maybe a
Nothing

epsSize :: ByteString -> Maybe ImageSize
epsSize :: ByteString -> Maybe ImageSize
epsSize ByteString
img = do
  let ls :: [ByteString]
ls = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ByteString
"%" ByteString -> ByteString -> Bool
`B.isPrefixOf`) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.lines ByteString
img
  let ls' :: [ByteString]
ls' = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"%%BoundingBox:" ByteString -> ByteString -> Bool
`B.isPrefixOf`)) [ByteString]
ls
  case [ByteString]
ls' of
       []    -> Maybe ImageSize
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       (ByteString
x:[ByteString]
_) -> case ByteString -> [ByteString]
B.words ByteString
x of
                     [ByteString
_, ByteString
llx, ByteString
lly, ByteString
urx, ByteString
ury] -> do
                        llx' <- Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Integer) -> Text -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8Lenient ByteString
llx
                        lly' <- safeRead $ TE.decodeUtf8Lenient lly
                        urx' <- safeRead $ TE.decodeUtf8Lenient urx
                        ury' <- safeRead $ TE.decodeUtf8Lenient ury
                        return ImageSize{
                            pxX  = urx' - llx'
                          , pxY  = ury' - lly'
                          , dpiX = 72
                          , dpiY = 72 }
                     [ByteString]
_ -> Maybe ImageSize
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

pdfSize :: ByteString -> Maybe ImageSize
pdfSize :: ByteString -> Maybe ImageSize
pdfSize ByteString
img =
  case Parser ImageSize -> ByteString -> Either String ImageSize
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser ImageSize
pPdfSize ByteString
img of
    Left String
_   -> Maybe ImageSize
forall a. Maybe a
Nothing
    Right ImageSize
sz -> ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just ImageSize
sz

pPdfSize :: A.Parser ImageSize
pPdfSize :: Parser ImageSize
pPdfSize =
  ((Char -> Bool) -> Parser ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') Parser ByteString -> Parser ImageSize -> Parser ImageSize
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ImageSize
pPdfSize)
  Parser ImageSize -> Parser ImageSize -> Parser ImageSize
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (do ByteString -> Parser ByteString
A.string ByteString
"/MediaBox"
      Parser ()
A.skipSpace
      Char -> Parser Word8
A.char8 Char
'['
      Parser ()
A.skipSpace
      [x1,y1,x2,y2] <- Int -> Parser ByteString Integer -> Parser ByteString [Integer]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
A.count Int
4 (Parser ByteString Integer -> Parser ByteString [Integer])
-> Parser ByteString Integer -> Parser ByteString [Integer]
forall a b. (a -> b) -> a -> b
$ do
        Parser ()
A.skipSpace
        raw <- Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Parser ByteString Char -> Parser ByteString String)
-> Parser ByteString Char -> Parser ByteString String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString Char
A.satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
        case safeRead $ T.pack raw of
          Just (Double
r :: Double) -> Integer -> Parser ByteString Integer
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Parser ByteString Integer)
-> Integer -> Parser ByteString Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
r
          Maybe Double
Nothing            -> Parser ByteString Integer
forall a. Parser ByteString a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      A.skipSpace
      A.char8 ']'
      return $ ImageSize{
              pxX  = x2 - x1
            , pxY  = y2 - y1
            , dpiX = 72
            , dpiY = 72 }
  )
  Parser ImageSize -> Parser ImageSize -> Parser ImageSize
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> -- if we encounter a compressed object stream, uncompress it (#10902)
  (do ByteString -> Parser ByteString
A.string ByteString
"/Type"
      Parser ()
A.skipSpace
      ByteString -> Parser ByteString
A.string ByteString
"/ObjStm"
      _ <- Parser ByteString -> Parser () -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
A.manyTill Parser ByteString
pLine (ByteString -> Parser ByteString
A.string ByteString
"stream" Parser ByteString -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
pEol)
      stream <- pTakeUntil "endstream"
      case A.parseOnly pPdfSize <$> safeDecompress stream of
        Just (Right ImageSize
is) -> ImageSize -> Parser ImageSize
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageSize
is
        Maybe (Either String ImageSize)
_ -> Parser ImageSize
pPdfSize)
  Parser ImageSize -> Parser ImageSize -> Parser ImageSize
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser ByteString Char
A.char Char
'/' Parser ByteString Char -> Parser ImageSize -> Parser ImageSize
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ImageSize
pPdfSize)
 where
   iseol :: Char -> Bool
iseol Char
'\r' = Bool
True
   iseol Char
'\n' = Bool
True
   iseol Char
_ = Bool
False
   pEol :: Parser ()
pEol = (Char -> Bool) -> Parser ByteString Char
A.satisfy Char -> Bool
iseol Parser ByteString Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany ((Char -> Bool) -> Parser ByteString Char
A.satisfy Char -> Bool
iseol)
   pLine :: Parser ByteString
pLine = (Char -> Bool) -> Parser ByteString
A.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
iseol) Parser ByteString -> Parser () -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
pEol

-- | Consume input up to and including the first occurrence of the
-- (non-empty) terminator, returning what precedes it.  Unlike
-- @manyTill anyWord8@, this consumes chunks at a time.
pTakeUntil :: ByteString -> A.Parser ByteString
pTakeUntil :: ByteString -> Parser ByteString
pTakeUntil ByteString
terminator = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Parser ByteString [ByteString]
go []
 where
  go :: [ByteString] -> Parser ByteString [ByteString]
go [ByteString]
acc = do
    chunk <- (Char -> Bool) -> Parser ByteString
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Char
B.head ByteString
terminator)
    let acc' = ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc
    (A.string terminator *> pure acc')
      <|> (do c <- A.take 1
              go (c : acc'))

-- | Decompress a zlib stream, returning Nothing on malformed input.
-- ('Codec.Compression.Zlib.decompress' would instead throw an
-- exception from pure code when the corrupt part of its lazy result
-- is forced.)
safeDecompress :: ByteString -> Maybe ByteString
safeDecompress :: ByteString -> Maybe ByteString
safeDecompress ByteString
bs = ([ByteString] -> ByteString)
-> Maybe [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
B.concat (Maybe [ByteString] -> Maybe ByteString)
-> Maybe [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
  (ByteString -> Maybe [ByteString] -> Maybe [ByteString])
-> (ByteString -> Maybe [ByteString])
-> (DecompressError -> Maybe [ByteString])
-> (forall s. DecompressStream (ST s))
-> ByteString
-> Maybe [ByteString]
forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
Zlib.foldDecompressStreamWithInput
    (\ByteString
chunk Maybe [ByteString]
rest -> (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> Maybe [ByteString] -> Maybe [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ByteString]
rest)
    (Maybe [ByteString] -> ByteString -> Maybe [ByteString]
forall a b. a -> b -> a
const ([ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
Just []))
    (Maybe [ByteString] -> DecompressError -> Maybe [ByteString]
forall a b. a -> b -> a
const Maybe [ByteString]
forall a. Maybe a
Nothing)
    (Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
Zlib.decompressST Format
Zlib.zlibFormat DecompressParams
Zlib.defaultDecompressParams)
    (ByteString -> ByteString
BL.fromStrict ByteString
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 :: ByteString -> Maybe ImageSize
pngSize ByteString
img =
  case Get ImageSize
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get ImageSize
pPngSize (ByteString -> ByteString
BL.fromStrict ByteString
img) of
    Left (ByteString, Int64, String)
_ -> Maybe ImageSize
forall a. Maybe a
Nothing
    Right (ByteString
_, Int64
_, ImageSize
sz) -> ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just ImageSize
sz
 where
  pPngSize :: Get ImageSize
pPngSize = do
    Int -> Get ()
skip Int
8  -- signature
    -- the IHDR chunk always comes first:
    ihdrLen <- Get Word32
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 :: Get (Integer, Integer)
findPhys = do
    done <- Get Bool
isEmpty
    if done
       then return (72, 72)
       else do
         len <- getWord32be
         typ <- getByteString 4
         case typ of
           ByteString
"pHYs" -> do
             ppuX <- Get Word32
getWord32be
             ppuY <- getWord32be
             unit <- getWord8
             return $ if unit == 1  -- pixels per meter
                         then (dpmToDpi (toInteger ppuX),
                               dpmToDpi (toInteger ppuY))
                         else (72, 72)
           ByteString
"IDAT" -> (Integer, Integer) -> Get (Integer, Integer)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
72, Integer
72)  -- pHYs must precede image data
           ByteString
"IEND" -> (Integer, Integer) -> Get (Integer, Integer)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
72, Integer
72)
           ByteString
_ -> Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Get () -> Get (Integer, Integer) -> Get (Integer, Integer)
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (Integer, Integer)
findPhys

-- | Convert dots per meter to dots per inch, using the same integer
-- arithmetic as JuicyPixels for consistency.
dpmToDpi :: Integer -> Integer
dpmToDpi :: Integer -> Integer
dpmToDpi Integer
z = Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
254 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
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)
-- and JFIF APP0 and Exif APP1 segments (which give the resolution).
jpegSize :: ByteString -> Maybe ImageSize
jpegSize :: ByteString -> Maybe ImageSize
jpegSize ByteString
img =
  case Get ImageSize
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Int -> Get ()
skip Int
2 Get () -> Get ImageSize -> Get ImageSize
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (Integer, Integer)
-> Maybe (Integer, Integer) -> Get ImageSize
scanSegments Maybe (Integer, Integer)
forall a. Maybe a
Nothing Maybe (Integer, Integer)
forall a. Maybe a
Nothing)
         (ByteString -> ByteString
BL.fromStrict ByteString
img) of
    Left (ByteString, Int64, String)
_ -> Maybe ImageSize
forall a. Maybe a
Nothing
    Right (ByteString
_, Int64
_, ImageSize
sz) -> ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just ImageSize
sz
 where
  scanSegments :: Maybe (Integer, Integer)
-> Maybe (Integer, Integer) -> Get ImageSize
scanSegments Maybe (Integer, Integer)
jfifDpi Maybe (Integer, Integer)
exifDpi = do
    ff <- Get Word8
getWord8
    when (ff /= 0xff) $ fail "malformed JPEG segment"
    marker <- skipFill
    scanSegment marker jfifDpi exifDpi

  -- extra 0xff bytes before a marker are padding:
  skipFill :: Get Word8
skipFill = do
    b <- Get Word8
getWord8
    if b == 0xff then skipFill else return b

  scanSegment :: Word8
-> Maybe (Integer, Integer)
-> Maybe (Integer, Integer)
-> Get ImageSize
scanSegment Word8
marker Maybe (Integer, Integer)
jfifDpi Maybe (Integer, Integer)
exifDpi
    -- start of frame (baseline, progressive, etc.); C4, C8, and CC
    -- in this range are entropy-coding markers, not SOF:
    | Word8
marker Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xc0 Bool -> Bool -> Bool
&& Word8
marker Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0xcf
      Bool -> Bool -> Bool
&& Word8
marker Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Word8
0xc4, Word8
0xc8, Word8
0xcc] = do
        Int -> Get ()
skip Int
3  -- segment length and sample precision
        h <- Get Word16
getWord16be
        w <- getWord16be
        -- as in JuicyPixels, Exif resolution overrides JFIF:
        let (dx, dy) = fromMaybe (fromMaybe (72, 72) jfifDpi) exifDpi
        return ImageSize{ pxX = toInteger w, pxY = toInteger h
                        , dpiX = dx, dpiY = dy }
    | Word8
marker Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xd9 Bool -> Bool -> Bool
|| Word8
marker Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xda =
        String -> Get ImageSize
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no SOF marker before image data"  -- EOI or SOS
    | (Word8
marker Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xd0 Bool -> Bool -> Bool
&& Word8
marker Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0xd7) Bool -> Bool -> Bool
|| Word8
marker Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01 =
        Maybe (Integer, Integer)
-> Maybe (Integer, Integer) -> Get ImageSize
scanSegments Maybe (Integer, Integer)
jfifDpi Maybe (Integer, Integer)
exifDpi  -- markers without a payload
    | Bool
otherwise = do
        len <- Get Word16
getWord16be
        when (len < 2) $ fail "invalid segment length"
        let n = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
        case marker of
          Word8
0xe0 -> do  -- APP0 (JFIF)
            body <- Int -> Get ByteString
getByteString Int
n
            scanSegments (jfifDensity body <|> jfifDpi) exifDpi
          Word8
0xe1 -> do  -- APP1 (Exif)
            body <- Int -> Get ByteString
getByteString Int
n
            scanSegments jfifDpi (exifDensity body <|> exifDpi)
          Word8
_ -> Int -> Get ()
skip Int
n Get () -> Get ImageSize -> Get ImageSize
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (Integer, Integer)
-> Maybe (Integer, Integer) -> Get ImageSize
scanSegments Maybe (Integer, Integer)
jfifDpi Maybe (Integer, Integer)
exifDpi

-- | Pixel density from the body of a JFIF APP0 segment.
jfifDensity :: ByteString -> Maybe (Integer, Integer)
jfifDensity :: ByteString -> Maybe (Integer, Integer)
jfifDensity ByteString
body = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
"JFIF\0" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
body
  -- after the identifier and 2-byte version: density units,
  -- horizontal density, vertical density
  (units, x, y) <- Int
-> Get (Word8, Word16, Word16)
-> ByteString
-> Maybe (Word8, Word16, Word16)
forall a. Int -> Get a -> ByteString -> Maybe a
getAt Int
7 ((,,) (Word8 -> Word16 -> Word16 -> (Word8, Word16, Word16))
-> Get Word8 -> Get (Word16 -> Word16 -> (Word8, Word16, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get (Word16 -> Word16 -> (Word8, Word16, Word16))
-> Get Word16 -> Get (Word16 -> (Word8, Word16, Word16))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be Get (Word16 -> (Word8, Word16, Word16))
-> Get Word16 -> Get (Word8, Word16, Word16)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be)
                     ByteString
body
  case units of
    Word8
1 -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
x, Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
y)  -- dots per inch
    Word8
2 -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer -> Integer
dpcmToDpi (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
x), Integer -> Integer
dpcmToDpi (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
y))  -- per cm
    Word8
_ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

-- | Resolution from the TIFF structure in the body of an Exif APP1
-- segment.
exifDensity :: ByteString -> Maybe (Integer, Integer)
exifDensity :: ByteString -> Maybe (Integer, Integer)
exifDensity ByteString
body = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
"Exif\0\0" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
body
  let tiff :: ByteString
tiff = Int -> ByteString -> ByteString
B.drop Int
6 ByteString
body  -- offsets are relative to the TIFF header
  (w16, w32) <- case Int -> ByteString -> ByteString
B.take Int
2 ByteString
tiff of
    ByteString
"II" -> (Get Word16, Get Word32) -> Maybe (Get Word16, Get Word32)
forall a. a -> Maybe a
Just (Get Word16
getWord16le, Get Word32
getWord32le)
    ByteString
"MM" -> (Get Word16, Get Word32) -> Maybe (Get Word16, Get Word32)
forall a. a -> Maybe a
Just (Get Word16
getWord16be, Get Word32
getWord32be)
    ByteString
_    -> Maybe (Get Word16, Get Word32)
forall a. Maybe a
Nothing
  ifd <- fromIntegral <$> getAt 4 w32 tiff
  n <- fromIntegral <$> getAt ifd w16 tiff
  entries <- mapM (\Int
i -> do let off :: Int
off = Int
ifd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i
                            tag <- Int -> Get Word16 -> ByteString -> Maybe Word16
forall a. Int -> Get a -> ByteString -> Maybe a
getAt Int
off Get Word16
w16 ByteString
tiff
                            return (tag, off))
                  [0 .. n - 1 :: Int]
  -- resolution unit (SHORT, stored inline in the value field):
  -- 2 = inches, 3 = centimeters
  unit <- lookup 0x0128 entries >>= \Int
off -> Int -> Get Word16 -> ByteString -> Maybe Word16
forall a. Int -> Get a -> ByteString -> Maybe a
getAt (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Get Word16
w16 ByteString
tiff
  toDpi <- case unit of
             Word16
2 -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just Integer -> Integer
forall a. a -> a
id
             Word16
3 -> (Integer -> Integer) -> Maybe (Integer -> Integer)
forall a. a -> Maybe a
Just Integer -> Integer
dpcmToDpi
             Word16
_ -> Maybe (Integer -> Integer)
forall a. Maybe a
Nothing
  let resolution Word16
tag = do
        off <- Word16 -> [(Word16, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word16
tag [(Word16, Int)]
entries
        -- the value field holds the offset of the RATIONAL value:
        valOff <- fromIntegral <$> getAt (off + 8) w32 tiff
        num <- getAt valOff w32 tiff
        den <- getAt (valOff + 4) w32 tiff
        guard $ den /= 0
        return $ toDpi (toInteger num `div` toInteger den)
  x <- resolution 0x011a  -- XResolution
  y <- resolution 0x011b  -- YResolution
  return (x, y)

-- | Convert dots per centimeter to dots per inch, using the same
-- integer arithmetic as JuicyPixels for consistency.
dpcmToDpi :: Integer -> Integer
dpcmToDpi :: Integer -> Integer
dpcmToDpi Integer
z = Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
254 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
100

-- | Run a 'Get' parser at the given offset in a strict ByteString,
-- returning Nothing if it fails (e.g. by running out of input).
getAt :: Int -> Get a -> ByteString -> Maybe a
getAt :: forall a. Int -> Get a -> ByteString -> Maybe a
getAt Int
off Get a
g ByteString
bs
  | Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = case Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Int -> Get ()
skip Int
off Get () -> Get a -> Get a
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get a
g) (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
      Left (ByteString, Int64, String)
_ -> Maybe a
forall a. Maybe a
Nothing
      Right (ByteString
_, Int64
_, a
x) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x

getSize :: ByteString -> Either T.Text ImageSize
getSize :: ByteString -> Either Text ImageSize
getSize ByteString
img =
  case ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata ByteString
img of
    Left String
e -> Text -> Either Text ImageSize
forall a b. a -> Either a b
Left (String -> Text
T.pack String
e)
    Right (DynamicImage
_, Metadatas
meta) -> do
      pxx <- Either Text Word
-> (Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Word
forall a b. a -> Either a b
Left Text
"Could not determine width") Word -> Either Text Word
forall a b. b -> Either a b
Right (Maybe Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall a b. (a -> b) -> a -> b
$
                   Keys Word -> Metadatas -> Maybe Word
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.Width Metadatas
meta
      pxy <- maybe (Left "Could not determine height") Right $
                   Metadata.lookup Metadata.Height meta
      dpix <- maybe (Right 72) Right $ Metadata.lookup Metadata.DpiX meta
      dpiy <- maybe (Right 72) Right $ Metadata.lookup Metadata.DpiY meta
      return $ ImageSize
                { pxX = fromIntegral pxx
                , pxY = fromIntegral pxy
                , dpiX = fromIntegral dpix
                , dpiY = fromIntegral dpiy }

svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize WriterOptions
opts ByteString
img = do
  doc <- (Text -> Maybe Element)
-> (Element -> Maybe Element)
-> Either Text Element
-> Maybe Element
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Element -> Text -> Maybe Element
forall a b. a -> b -> a
const Maybe Element
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) Element -> Maybe Element
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Element -> Maybe Element)
-> Either Text Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Element
parseXMLElement
                                     (Text -> Either Text Element) -> Text -> Either Text Element
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropBOM ByteString
img
  let viewboxSize = do
        vb <- (QName -> Bool) -> Element -> Maybe Text
findAttrBy (QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
"viewBox" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
doc
        -- per the SVG spec, the numbers are separated by whitespace
        -- and/or a comma, and may be fractional:
        [_,_,w,h] <- mapM safeRead $ T.words $
                       T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' then Char
' ' else Char
c) vb
        return (floor (w :: Double), floor (h :: Double))
  let dpi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerDpi WriterOptions
opts
  let dirToInt Text
dir = do
        dim <- (QName -> Bool) -> Element -> Maybe Text
findAttrBy (QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
dir Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
doc Maybe Text -> (Text -> Maybe Dimension) -> Maybe Dimension
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Dimension
lengthToDim
        case dim of
           Percent Double
_ -> Maybe Integer
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
           Dimension
_ -> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Integer
inPixel WriterOptions
opts Dimension
dim
  w <- dirToInt "width" <|> (fst <$> viewboxSize)
  h <- dirToInt "height" <|> (snd <$> viewboxSize)
  return ImageSize {
    pxX  = w
  , pxY  = h
  , dpiX = dpi
  , dpiY = dpi
  }

emfSize :: ByteString -> Maybe ImageSize
emfSize :: ByteString -> Maybe ImageSize
emfSize ByteString
img =
  let
    parseheader :: ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
parseheader = Get ImageSize
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get ImageSize
 -> ByteString
 -> Either
      (ByteString, Int64, String) (ByteString, Int64, ImageSize))
-> Get ImageSize
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
forall a b. (a -> b) -> a -> b
$ do
      Int -> Get ()
skip Int
0x18             -- 0x00
      -- the frame bounds are signed, measured in 1/100 of a millimetre:
      frameL <- Get Int32
getInt32le  -- 0x18
      frameT <- getInt32le  -- 0x1C
      frameR <- getInt32le  -- 0x20
      frameB <- getInt32le  -- 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      -- 0x54
      -- end of header
      -- guard against division by zero below; since the ImageSize
      -- fields are lazy, the exception would escape runGetOrFail
      when (mmX == 0 || mmY == 0) $
        fail "EMF header has zero-size reference device"
      -- compute with Integers to avoid Word32 overflow:
      let
        w = (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
deviceX Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
frameR Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
frameL))
              Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
mmX Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100)
        h = (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
deviceY Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
frameB Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
frameT))
              Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
mmY Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100)
        dpiW = (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
deviceX Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
254) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
mmX Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10)
        dpiH = (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
deviceY Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
254) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
mmY Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10)
      return $ ImageSize
        { pxX = w
        , pxY = h
        , dpiX = dpiW
        , dpiY = dpiH
        }
  in
    case ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
parseheader (ByteString
 -> Either
      (ByteString, Int64, String) (ByteString, Int64, ImageSize))
-> (ByteString -> ByteString)
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString
 -> Either
      (ByteString, Int64, String) (ByteString, Int64, ImageSize))
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ImageSize)
forall a b. (a -> b) -> a -> b
$ ByteString
img of
      Left (ByteString, Int64, String)
_ -> Maybe ImageSize
forall a. Maybe a
Nothing
      Right (ByteString
_, Int64
_, ImageSize
size) -> ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just ImageSize
size

-- See https://developers.google.com/speed/webp/docs/riff_container
-- and RFC 6386
pWebpSize :: AW.Parser ImageSize
pWebpSize :: Parser ImageSize
pWebpSize = do
  ByteString -> Parser ByteString
AW.string ByteString
"RIFF"
  Int -> Parser ByteString
AW.take Int
4
  ByteString -> Parser ByteString
AW.string ByteString
"WEBP"
  (w, h) <- Parser ByteString (Integer, Integer)
lossy Parser ByteString (Integer, Integer)
-> Parser ByteString (Integer, Integer)
-> Parser ByteString (Integer, Integer)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Integer, Integer)
lossless Parser ByteString (Integer, Integer)
-> Parser ByteString (Integer, Integer)
-> Parser ByteString (Integer, Integer)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Integer, Integer)
extended
  return $ def
    { pxX = w
    , pxY = h
    }
  where
    bitsToMaybe :: Either a (a, b, a) -> Maybe a
bitsToMaybe = (a -> Maybe a)
-> ((a, b, a) -> Maybe a) -> Either a (a, b, a) -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (\((a
_, b
_, a
s)) -> a -> Maybe a
forall a. a -> Maybe a
Just a
s)
    decode :: (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
decode ByteString -> Either a (a, b, a)
d = Either a (a, b, a) -> Maybe a
forall {a} {a} {b} {a}. Either a (a, b, a) -> Maybe a
bitsToMaybe (Either a (a, b, a) -> Maybe a)
-> (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either a (a, b, a)
d (ByteString -> Either a (a, b, a))
-> (ByteString -> ByteString) -> ByteString -> Either a (a, b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict
    lossySize :: ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Word16)
lossySize = Get Word16
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Word16)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get Word16
 -> ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, Word16))
-> Get Word16
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Word16)
forall a b. (a -> b) -> a -> b
$ do
      word <- Get Word16
getWord16le
      return $ word .&. 0x3FFF
    lossy :: Parser ByteString (Integer, Integer)
lossy = do
      ByteString -> Parser ByteString
AW.string ByteString
"VP8 "
      Int -> Parser ByteString
AW.take Int
4 -- length in bytes of VP8 Lossy stream size
      keyFrame <-  Parser Word8
AW.anyWord8
      guard $ keyFrame .&. 1 == 0
      AW.take 2 -- remaining bytes of frame header
      AW.word8 0x9d  -- VP8 keyframe magic
      AW.word8 0x01
      AW.word8 0x2a
      width16 <- AW.take 2
      height16 <- AW.take 2
      case (decode lossySize width16, decode lossySize height16) of
        (Just Word16
w, Just Word16
h) -> (Integer, Integer) -> Parser ByteString (Integer, Integer)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
w, Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
h)
        (Maybe Word16, Maybe Word16)
_ -> Parser ByteString (Integer, Integer)
forall a. Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a
empty
    -- The VP8L bitstream is read starting from the least significant
    -- bit of each byte, so after reading the 4 bytes as a little-endian
    -- word, width - 1 is in bits 0-13 and height - 1 in bits 14-27.
    losslessSizes :: ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Word32)
losslessSizes = Get Word32
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Word32)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get Word32
getWord32le
    losslessSize :: a -> a
losslessSize a
word = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
word a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3FFF)
    lossless :: Parser ByteString (Integer, Integer)
lossless = do
      ByteString -> Parser ByteString
AW.string ByteString
"VP8L"
      Int -> Parser ByteString
AW.take Int
4 -- length in bytes of VP8 Lossless chunk size
      Word8 -> Parser Word8
AW.word8 Word8
0x2f  -- webp lossless stream magic
      sizes <- Int -> Parser ByteString
AW.take Int
4
      case decode losslessSizes sizes of
        Just Word32
word -> (Integer, Integer) -> Parser ByteString (Integer, Integer)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall {a}. (Num a, Bits a) => a -> a
losslessSize Word32
word
                            , Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall {a}. (Num a, Bits a) => a -> a
losslessSize (Word32
word Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
14) )
        Maybe Word32
Nothing -> Parser ByteString (Integer, Integer)
forall a. Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a
empty
    extendedSize :: ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Integer)
extendedSize = Get Integer
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Integer)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get Integer
 -> ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, Integer))
-> Get Integer
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Integer)
forall a b. (a -> b) -> a -> b
$ do
      low <- Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
      high <- toInteger <$> getWord8
      return $ 1 + (high `shiftL` 16) + (low)
    extended :: Parser ByteString (Integer, Integer)
extended = do
      ByteString -> Parser ByteString
AW.string ByteString
"VP8X"
      Int -> Parser ByteString
AW.take Int
8  -- VP8X chunk length, flags and reserved area
      width24 <- Int -> Parser ByteString
AW.take Int
3
      height24 <- AW.take 3
      case (decode extendedSize width24, decode extendedSize height24) of
        (Just Integer
w, Just Integer
h) -> (Integer, Integer) -> Parser ByteString (Integer, Integer)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
w, Integer
h)
        (Maybe Integer, Maybe Integer)
_ -> Parser ByteString (Integer, Integer)
forall a. Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a
empty

webpSize :: WriterOptions -> ByteString -> Maybe ImageSize
webpSize :: WriterOptions -> ByteString -> Maybe ImageSize
webpSize WriterOptions
opts ByteString
img =
  case Parser ImageSize -> ByteString -> Either String ImageSize
forall a. Parser a -> ByteString -> Either String a
AW.parseOnly Parser ImageSize
pWebpSize ByteString
img of
    Left String
_   -> Maybe ImageSize
forall a. Maybe a
Nothing
    Right ImageSize
sz -> ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just ImageSize
sz { dpiX = fromIntegral $ writerDpi opts, dpiY = fromIntegral $ writerDpi opts}

avifSize :: WriterOptions -> ByteString -> Maybe ImageSize
avifSize :: WriterOptions -> ByteString -> Maybe ImageSize
avifSize WriterOptions
opts ByteString
img =
  case Get (Word32, Word32)
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, (Word32, Word32))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get ()
verifyFtyp Get () -> Get (Word32, Word32) -> Get (Word32, Word32)
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Word32, Word32)
findAvifDimensions) (ByteString -> ByteString
BL.fromStrict ByteString
img) of
    Left (ByteString
_, Int64
_, String
_err) -> Maybe ImageSize
forall a. Maybe a
Nothing
    Right (ByteString
_, Int64
_, (Word32
width, Word32
height)) ->
      ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just (ImageSize -> Maybe ImageSize) -> ImageSize -> Maybe ImageSize
forall a b. (a -> b) -> a -> b
$ ImageSize { pxX :: Integer
pxX = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width
                       , pxY :: Integer
pxY = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height
                       , dpiX :: Integer
dpiX = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerDpi WriterOptions
opts
                       , dpiY :: Integer
dpiY = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerDpi WriterOptions
opts }

---- AVIF parsing:

-- | Read an ISO BMFF box header, returning the box type, the size of
-- the box contents, and the size of the header itself.  Handles the
-- 64-bit "largesize" field (size == 1) and boxes that extend to the
-- end of the file (size == 0).
getBoxHeader :: Get (B.ByteString, Int, Int)
getBoxHeader :: Get (ByteString, Int, Int)
getBoxHeader = do
  boxSize <- Get Word32
getWord32be
  boxType <- getByteString 4
  case boxSize of
    Word32
0 -> do  -- the box extends to the end of the file
      rest <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead Get ByteString
getRemainingLazyByteString
      return (boxType, fromIntegral (BL.length rest), 8)
    Word32
1 -> do  -- a 64-bit size follows the box type
      largeSize <- Get Word64
getWord64be
      when (largeSize < 16 || largeSize > 0x7fffffff) $
        fail "invalid box largesize"
      return (boxType, fromIntegral largeSize - 16, 16)
    Word32
_ -> do
      Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
boxSize Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
8) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid box size"
      (ByteString, Int, Int) -> Get (ByteString, Int, Int)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
boxType, Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
boxSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8, Int
8)

verifyFtyp :: Get ()
verifyFtyp :: Get ()
verifyFtyp = do
  (boxType, contentSize, _) <- Get (ByteString, Int, Int)
getBoxHeader
  unless (boxType == "ftyp") $ fail "ftyp signature not found"
  when (contentSize < 8) $ fail "Invalid ftyp size"

  brand <- getByteString 4
  unless (brand == "avif" || brand == "avis") $ fail "Not an AVIF file"

  -- Skip minor version and compatible brands
  skip (contentSize - 4)

findAvifDimensions :: Get (Word32, Word32)
findAvifDimensions :: Get (Word32, Word32)
findAvifDimensions = [ByteString] -> Get (Word32, Word32)
searchAvifBoxes []

searchAvifBoxes :: [B.ByteString] -> Get (Word32, Word32)
searchAvifBoxes :: [ByteString] -> Get (Word32, Word32)
searchAvifBoxes [ByteString]
path = do
  isempty <- Get Bool
isEmpty
  if isempty
    then fail $ "No dimensions found. Searched: " ++ show (reverse path)
    else do
      (boxType, contentSize, _) <- getBoxHeader
      let newPath = ByteString
boxType ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
path

      -- If it's a container box, search inside it
      if isContainerBox boxType
        then searchInsideBox contentSize newPath
        else do
          -- Try to parse dimensions from this box
          result <- tryParseDimensions boxType contentSize
          case result of
            Just (Word32, Word32)
dims -> (Word32, Word32) -> Get (Word32, Word32)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32, Word32)
dims
            Maybe (Word32, Word32)
Nothing ->
              -- Don't skip here - tryParseDimensions already handled it
              [ByteString] -> Get (Word32, Word32)
searchAvifBoxes [ByteString]
path

tryParseDimensions :: B.ByteString -> Int -> Get (Maybe (Word32, Word32))
tryParseDimensions :: ByteString -> Int -> Get (Maybe (Word32, Word32))
tryParseDimensions ByteString
boxType Int
size = do
  pos <- Get Int64
bytesRead
  result <- case boxType of
    ByteString
"ispe" -> Get (Maybe (Word32, Word32))
parseIspeBox
    ByteString
"tkhd" -> Get (Maybe (Word32, Word32))
parseTkhdBox
    ByteString
"stsd" -> Get (Maybe (Word32, Word32))
parseStsdBox
    ByteString
"av01" -> Get (Maybe (Word32, Word32))
parseAv01Box
    ByteString
_ -> Maybe (Word32, Word32) -> Get (Maybe (Word32, Word32))
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Word32, Word32)
forall a. Maybe a
Nothing

  -- Reset position if we didn't find dimensions
  case result of
    Maybe (Word32, Word32)
Nothing -> do
      newPos <- Get Int64
bytesRead
      let consumed = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
newPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
pos)
      case size - consumed of
        Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> Get ()
skip Int
n
        Int
_ -> () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Word32, Word32)
_ -> () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  return result

parseIspeBox :: Get (Maybe (Word32, Word32))
parseIspeBox :: Get (Maybe (Word32, Word32))
parseIspeBox = do
  Int -> Get ()
skip Int
4  -- version/flags
  width <- Get Word32
getWord32be
  height <- getWord32be
  return $ Just (width, height)

parseTkhdBox :: Get (Maybe (Word32, Word32))
parseTkhdBox :: Get (Maybe (Word32, Word32))
parseTkhdBox = do
  version <- Get Word8
getWord8
  skip 3  -- flags

  -- Skip to width/height based on version:
  -- creation/modification times, track ID, reserved, duration
  -- (20 bytes with 32-bit times, 32 bytes with 64-bit times),
  -- then 8 reserved, layer, alternate_group, volume, reserved
  -- (2 bytes each), and the 36-byte transformation matrix
  let skipBytes = if Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 then Int
84 else Int
72
  skip skipBytes

  width <- getWord32be
  height <- getWord32be
  -- Convert from 16.16 fixed point
  return $ Just (width `shiftR` 16, height `shiftR` 16)

parseStsdBox :: Get (Maybe (Word32, Word32))
parseStsdBox :: Get (Maybe (Word32, Word32))
parseStsdBox = do
  Int -> Get ()
skip Int
8  -- version, flags, entry count
  Get (Maybe (Word32, Word32))
findAv01Entry

findAv01Entry :: Get (Maybe (Word32, Word32))
findAv01Entry :: Get (Maybe (Word32, Word32))
findAv01Entry = do
  entrySize <- Get Word32
getWord32be
  codec <- getByteString 4

  if codec == "av01"
    then do
      skip 6  -- reserved
      skip 2  -- data reference index
      skip 16 -- pre-defined + reserved
      width <- getWord16be
      height <- getWord16be
      return $ Just (fromIntegral width, fromIntegral height)
    else do
      let skipSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
entrySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8
      when (skipSize > 0) $ skip skipSize
      findAv01Entry

parseAv01Box :: Get (Maybe (Word32, Word32))
parseAv01Box :: Get (Maybe (Word32, Word32))
parseAv01Box = do
  Int -> Get ()
skip Int
6   -- reserved
  Int -> Get ()
skip Int
2   -- data reference index
  Int -> Get ()
skip Int
16  -- predefined/reserved
  width <- Get Word16
getWord16be
  height <- getWord16be
  return $ Just (fromIntegral width, fromIntegral height)

searchInsideBox :: Int -> [B.ByteString] -> Get (Word32, Word32)
searchInsideBox :: Int -> [ByteString] -> Get (Word32, Word32)
searchInsideBox Int
size [ByteString]
path = do
  -- For meta boxes, skip version/flags
  let isMeta :: Bool
isMeta = case [ByteString]
path of
                 ByteString
"meta":[ByteString]
_ -> Bool
True
                 [ByteString]
_ -> Bool
False
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isMeta (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ Int -> Get ()
skip Int
4

  let searchSize :: Int
searchSize = if Bool
isMeta then Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4 else Int
size
  Int -> [ByteString] -> Get (Word32, Word32)
searchAvifBoxesInRange Int
searchSize [ByteString]
path

searchAvifBoxesInRange :: Int -> [B.ByteString] -> Get (Word32, Word32)
searchAvifBoxesInRange :: Int -> [ByteString] -> Get (Word32, Word32)
searchAvifBoxesInRange Int
remaining' [ByteString]
path
  | Int
remaining' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 = [ByteString] -> Get (Word32, Word32)
searchAvifBoxes [ByteString]
path
  | Bool
otherwise = do
      (boxType, contentSize, headerSize) <- Get (ByteString, Int, Int)
getBoxHeader

      let newPath = ByteString
boxType ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
path

      when (contentSize + headerSize > remaining') $
        fail $ "Malformed box at path: " ++ show (reverse newPath)

      if isContainerBox boxType
        then searchInsideBox contentSize newPath
        else do
          result <- tryParseDimensions boxType contentSize
          case result of
            Just (Word32, Word32)
dims -> (Word32, Word32) -> Get (Word32, Word32)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32, Word32)
dims
            Maybe (Word32, Word32)
Nothing -> do
              -- Don't skip here - tryParseDimensions already handled it
              Int -> [ByteString] -> Get (Word32, Word32)
searchAvifBoxesInRange
                (Int
remaining' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
contentSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
headerSize) [ByteString]
path

isContainerBox :: B.ByteString -> Bool
isContainerBox :: ByteString -> Bool
isContainerBox ByteString
boxType = ByteString
boxType ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
  [ByteString
"moov", ByteString
"trak", ByteString
"mdia", ByteString
"minf", ByteString
"stbl", ByteString
"meta", ByteString
"dinf", ByteString
"ipco", ByteString
"iprp"]