    {-# 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 (bitReverse32)
    import Data.Maybe (isJust, fromJust)
    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)

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

    data ImageType = Png | Gif | Jpeg | Svg | Pdf | Eps | Emf | Tiff | Webp
                     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
    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
                   | 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 (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\xe0" -> ImageType -> Maybe ImageType
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImageType
    Jpeg  -- JFIF
                         ByteString
    "\xff\xd8\xff\xe1" -> ImageType -> Maybe ImageType
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImageType
    Jpeg  -- Exif
                         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
    _ -> Maybe ImageType
    forall a. Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

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

    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  -> ByteString -> Either Text ImageSize
    getSize ByteString
    img
           Just ImageType
    Gif  -> ByteString -> Either Text ImageSize
    getSize ByteString
    img
           Just ImageType
    Jpeg -> 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
           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
            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
        (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
        (Centimeter Double
    a) -> Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Double
    dpi Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    a Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    0.3937007874 :: Integer
        (Millimeter Double
    a) -> Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Double
    dpi Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    a Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    0.03937007874 :: Integer
        (Inch Double
    a)       -> Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Double
    dpi Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    a :: Integer
        (Percent Double
    _)    -> Integer
    0
        (Em Double
    a)         -> Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Double
    dpi Double -> Double -> Double
    forall a. Num a => a -> a -> 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) :: Integer
      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")
    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
    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)
            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
    Inch (Double
    a Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    72)
        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
    Inch (Double
    a Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    6)
        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
    _, ByteString
    _, ByteString
    ux, ByteString
    uy] -> do
                            ux' <- 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.decodeUtf8 ByteString
    ux
                            uy' <- safeRead $ TE.decodeUtf8 uy
                            return ImageSize{
                                pxX  = ux'
                              , pxY  = uy'
                              , 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 = do
      (Char -> Bool) -> Parser ()
    A.skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '/')
      Char -> Parser Word8
    A.char8 Char
    '/'
      (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
    <|> Parser ImageSize
    pPdfSize

    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
            [_,_,w,h] <- mapM safeRead (T.words vb)
            return (w,h)
      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
            return $ inPixel opts 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, ByteOffset, String)
         (ByteString, ByteOffset, ImageSize)
    parseheader = Get ImageSize
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, ImageSize)
    forall a.
    Get a
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
    runGetOrFail (Get ImageSize
     -> ByteString
     -> Either
          (ByteString, ByteOffset, String)
          (ByteString, ByteOffset, ImageSize))
    -> Get ImageSize
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, ImageSize)
    forall a b. (a -> b) -> a -> b
    $ do
          Int -> Get ()
    skip Int
    0x18             -- 0x00
          frameL <- Get Word32
    getWord32le -- 0x18  measured in 1/100 of a millimetre
          frameT <- getWord32le -- 0x1C
          frameR <- getWord32le -- 0x20
          frameB <- getWord32le -- 0x24
          skip 0x20             -- 0x28
          deviceX <- getWord32le  -- 0x48 pixels of reference device
          deviceY <- getWord32le  -- 0x4C
          mmX <- getWord32le      -- 0x50 real mm of reference device (always 320*240?)
          mmY <- getWord32le      -- 0x58
          -- end of header
          let
            w = (Word32
    deviceX Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * (Word32
    frameR Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    frameL)) Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `quot` (Word32
    mmX Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    100)
            h = (Word32
    deviceY Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * (Word32
    frameB Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    frameT)) Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `quot` (Word32
    mmY Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    100)
            dpiW = (Word32
    deviceX Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    254) Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `quot` (Word32
    mmX Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    10)
            dpiH = (Word32
    deviceY Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    254) Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `quot` (Word32
    mmY Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    10)
          return $ ImageSize
            { pxX = fromIntegral w
            , pxY = fromIntegral h
            , dpiX = fromIntegral dpiW
            , dpiY = fromIntegral dpiH
            }
      in
        case ByteString
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, ImageSize)
    parseheader (ByteString
     -> Either
          (ByteString, ByteOffset, String)
          (ByteString, ByteOffset, ImageSize))
    -> (ByteString -> ByteString)
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, ImageSize)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString
     -> Either
          (ByteString, ByteOffset, String)
          (ByteString, ByteOffset, ImageSize))
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, ImageSize)
    forall a b. (a -> b) -> a -> b
    $ ByteString
    img of
          Left (ByteString, ByteOffset, String)
    _ -> Maybe ImageSize
    forall a. Maybe a
    Nothing
          Right (ByteString
    _, ByteOffset
    _, 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, ByteOffset, String) (ByteString, ByteOffset, Word16)
    lossySize = Get Word16
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16)
    forall a.
    Get a
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
    runGetOrFail (Get Word16
     -> ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16))
    -> Get Word16
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, 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
          let w = Word16 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Word16 -> Integer) -> Maybe Word16 -> Maybe Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16))
    -> ByteString -> Maybe Word16
    forall {a} {a} {b} {a}.
    (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
    decode ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16)
    lossySize ByteString
    width16
              h = Word16 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Word16 -> Integer) -> Maybe Word16 -> Maybe Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16))
    -> ByteString -> Maybe Word16
    forall {a} {a} {b} {a}.
    (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
    decode ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word16)
    lossySize ByteString
    height16
          guard $ isJust w && isJust h
          return (fromJust w, fromJust h)
        losslessSizes :: ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
    losslessSizes = Get Word32
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
    forall a.
    Get a
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
    runGetOrFail (Get Word32
     -> ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32))
    -> Get Word32
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
    forall a b. (a -> b) -> a -> b
    $ do
          Word32 -> Word32
    bitReverse32 (Word32 -> Word32) -> Get Word32 -> Get Word32
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> 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
          let mbword = (ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32))
    -> ByteString -> Maybe Word32
    forall {a} {a} {b} {a}.
    (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
    decode ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
    losslessSizes ByteString
    sizes
          guard $ isJust mbword
          let word = Maybe Word32 -> Word32
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe Word32
    mbword
          let w = 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
              h = 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)
          return (w, h)
        extendedSize :: ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer)
    extendedSize = Get Integer
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer)
    forall a.
    Get a
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
    runGetOrFail (Get Integer
     -> ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer))
    -> Get Integer
    -> ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, 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
          let w = (ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer))
    -> ByteString -> Maybe Integer
    forall {a} {a} {b} {a}.
    (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
    decode ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer)
    extendedSize ByteString
    width24
              h = (ByteString
     -> Either
          (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer))
    -> ByteString -> Maybe Integer
    forall {a} {a} {b} {a}.
    (ByteString -> Either a (a, b, a)) -> ByteString -> Maybe a
    decode ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Integer)
    extendedSize ByteString
    height24
          guard $ isJust w && isJust h
          return (fromJust w, fromJust h)

    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}