    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE CPP #-}
    -- | Module used for loading & writing \'Portable Network Graphics\' (PNG)

    -- files.

    --

    -- A high level API is provided. It loads and saves images for you

    -- while hiding all the details about PNG chunks.

    --

    -- Basic functions for PNG handling are 'decodePng', 'encodePng'

    -- and 'encodePalettedPng'. Convenience functions are provided

    -- for direct file handling and using 'DynamicImage's.

    --

    -- The loader has been validated against the pngsuite (http://www.libpng.org/pub/png/pngsuite.html)

    module Codec.Picture.Png( -- * High level functions

                              PngSavable( .. ),
                              PngPaletteSaveable( .. )

                            , decodePng
                            , decodePngWithMetadata
                            , decodePngWithPaletteAndMetadata

                            , writePng
                            , encodeDynamicPng
                            , writeDynamicPng
                            ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative( (<$>) )
    #endif

    import Control.Arrow( first )
    import Control.Monad( forM_, foldM_, when, void )
    import Control.Monad.ST( ST, runST )

    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid( (<>) )
    #endif

    import Data.Binary( Binary( get) )

    import qualified Data.Vector.Storable as V
    import qualified Data.Vector.Storable.Mutable as M
    import Data.Bits( (.&.), (.|.), unsafeShiftL, unsafeShiftR )
    import Data.List( find, zip4 )
    import Data.Word( Word8, Word16, Word32 )
    import qualified Codec.Compression.Zlib as Z
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Unsafe as BU
    import qualified Data.ByteString.Lazy as Lb
    import Foreign.Storable ( Storable )

    import Codec.Picture.Types
    import Codec.Picture.Metadata
    import Codec.Picture.Png.Internal.Type
    import Codec.Picture.Png.Internal.Export
    import Codec.Picture.Png.Internal.Metadata
    import Codec.Picture.InternalHelper

    -- | Simple structure used to hold information about Adam7 deinterlacing.

    -- A structure is used to avoid pollution of the module namespace.

    data Adam7MatrixInfo = Adam7MatrixInfo
        { Adam7MatrixInfo -> [Int]
    adam7StartingRow  :: [Int]
        , Adam7MatrixInfo -> [Int]
    adam7StartingCol  :: [Int]
        , Adam7MatrixInfo -> [Int]
    adam7RowIncrement :: [Int]
        , Adam7MatrixInfo -> [Int]
    adam7ColIncrement :: [Int]
        , Adam7MatrixInfo -> [Int]
    adam7BlockHeight  :: [Int]
        , Adam7MatrixInfo -> [Int]
    adam7BlockWidth   :: [Int]
        }

    -- | The real info about the matrix.

    adam7MatrixInfo :: Adam7MatrixInfo
    adam7MatrixInfo :: Adam7MatrixInfo
    adam7MatrixInfo = Adam7MatrixInfo
        { adam7StartingRow :: [Int]
    adam7StartingRow  = [Int
    0, Int
    0, Int
    4, Int
    0, Int
    2, Int
    0, Int
    1]
        , adam7StartingCol :: [Int]
    adam7StartingCol  = [Int
    0, Int
    4, Int
    0, Int
    2, Int
    0, Int
    1, Int
    0]
        , adam7RowIncrement :: [Int]
    adam7RowIncrement = [Int
    8, Int
    8, Int
    8, Int
    4, Int
    4, Int
    2, Int
    2]
        , adam7ColIncrement :: [Int]
    adam7ColIncrement = [Int
    8, Int
    8, Int
    4, Int
    4, Int
    2, Int
    2, Int
    1]
        , adam7BlockHeight :: [Int]
    adam7BlockHeight  = [Int
    8, Int
    8, Int
    4, Int
    4, Int
    2, Int
    2, Int
    1]
        , adam7BlockWidth :: [Int]
    adam7BlockWidth   = [Int
    8, Int
    4, Int
    4, Int
    2, Int
    2, Int
    1, Int
    1]
        }

    unparsePngFilter :: Word8 -> Either String PngFilter
    {-# INLINE unparsePngFilter #-}
    unparsePngFilter :: Pixel8 -> Either String PngFilter
    unparsePngFilter Pixel8
    0 = PngFilter -> Either String PngFilter
    forall a b. b -> Either a b
    Right PngFilter
    FilterNone
    unparsePngFilter Pixel8
    1 = PngFilter -> Either String PngFilter
    forall a b. b -> Either a b
    Right PngFilter
    FilterSub
    unparsePngFilter Pixel8
    2 = PngFilter -> Either String PngFilter
    forall a b. b -> Either a b
    Right PngFilter
    FilterUp
    unparsePngFilter Pixel8
    3 = PngFilter -> Either String PngFilter
    forall a b. b -> Either a b
    Right PngFilter
    FilterAverage
    unparsePngFilter Pixel8
    4 = PngFilter -> Either String PngFilter
    forall a b. b -> Either a b
    Right PngFilter
    FilterPaeth
    unparsePngFilter Pixel8
    _ = String -> Either String PngFilter
    forall a b. a -> Either a b
    Left String
    "Invalid scanline filter"

    getBounds :: (Monad m, Storable a) => M.STVector s a -> m (Int, Int)
    {-# INLINE getBounds #-}
    getBounds :: forall (m :: * -> *) a s.
    (Monad m, Storable a) =>
    STVector s a -> m (Int, Int)
    getBounds STVector s a
    v = (Int, Int) -> m (Int, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    0, STVector s a -> Int
    forall a s. Storable a => MVector s a -> Int
    M.length STVector s a
    v Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    -- | Apply a filtering method on a reduced image. Apply the filter

    -- on each line, using the previous line (the one above it) to perform

    -- some prediction on the value.

    pngFiltering :: LineUnpacker s -> Int -> (Int, Int)    -- ^ Image size

                 -> B.ByteString -> Int
                 -> ST s Int
    pngFiltering :: forall s.
    LineUnpacker s
    -> Int -> (Int, Int) -> ByteString -> Int -> ST s Int
    pngFiltering LineUnpacker s
    _ Int
    _ (Int
    imgWidth, Int
    imgHeight) ByteString
    _str Int
    initialIdx
            | Int
    imgWidth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 Bool -> Bool -> Bool
    || Int
    imgHeight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    initialIdx
    pngFiltering LineUnpacker s
    unpacker Int
    beginZeroes (Int
    imgWidth, Int
    imgHeight) ByteString
    str Int
    initialIdx = do
        PngLine s
    thisLine <- Int -> Pixel8 -> ST s (MVector (PrimState (ST s)) Pixel8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> a -> m (MVector (PrimState m) a)
    M.replicate (Int
    beginZeroes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    imgWidth) Pixel8
    0
        PngLine s
    otherLine <- Int -> Pixel8 -> ST s (MVector (PrimState (ST s)) Pixel8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> a -> m (MVector (PrimState m) a)
    M.replicate (Int
    beginZeroes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    imgWidth) Pixel8
    0
        let folder :: PngLine s -> PngLine s -> Int -> Int -> ST s Int
    folder            PngLine s
    _          PngLine s
    _  Int
    lineIndex !Int
    idx | Int
    lineIndex Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    imgHeight = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    idx
            folder PngLine s
    previousLine PngLine s
    currentLine Int
    lineIndex !Int
    idx = do
                   let byte :: Pixel8
    byte = ByteString
    str ByteString -> Int -> Pixel8
    `BU.unsafeIndex` Int
    idx
                   let lineFilter :: PngLine s -> PngLine s -> Int -> ST s Int
    lineFilter = case Pixel8 -> Either String PngFilter
    unparsePngFilter Pixel8
    byte of
                           Right PngFilter
    FilterNone    -> PngLine s -> PngLine s -> Int -> ST s Int
    forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterNone
                           Right PngFilter
    FilterSub     -> PngLine s -> PngLine s -> Int -> ST s Int
    forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterSub
                           Right PngFilter
    FilterAverage -> PngLine s -> PngLine s -> Int -> ST s Int
    forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterAverage
                           Right PngFilter
    FilterUp      -> PngLine s -> PngLine s -> Int -> ST s Int
    forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterUp
                           Right PngFilter
    FilterPaeth   -> PngLine s -> PngLine s -> Int -> ST s Int
    forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterPaeth
                           Either String PngFilter
    _ -> PngLine s -> PngLine s -> Int -> ST s Int
    forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterNone
                   Int
    idx' <- PngLine s -> PngLine s -> Int -> ST s Int
    lineFilter PngLine s
    previousLine PngLine s
    currentLine (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                   LineUnpacker s
    unpacker Int
    lineIndex (Int
    stride, PngLine s
    currentLine)
                   PngLine s -> PngLine s -> Int -> Int -> ST s Int
    folder PngLine s
    currentLine PngLine s
    previousLine (Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int
    idx'

        PngLine s -> PngLine s -> Int -> Int -> ST s Int
    folder PngLine s
    thisLine PngLine s
    otherLine (Int
    0 :: Int) Int
    initialIdx

        where stride :: Int
    stride = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    beginZeroes
              lastIdx :: Int
    lastIdx = Int
    beginZeroes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

              -- The filter implementation are... well non-idiomatic

              -- to say the least, but my benchmarks proved me one thing,

              -- they are faster than mapM_, gained something like 5% with

              -- a rewrite from mapM_ to this direct version

              filterNone, filterSub, filterUp, filterPaeth,
                    filterAverage :: PngLine s -> PngLine s -> Int -> ST s Int
              filterNone :: forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterNone !PngLine s
    _previousLine !PngLine s
    thisLine = Int -> Int -> ST s Int
    inner Int
    beginZeroes
                where inner :: Int -> Int -> ST s Int
    inner Int
    idx !Int
    readIdx
                                | Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    lastIdx = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    readIdx
                                | Bool
    otherwise = do let byte :: Pixel8
    byte = ByteString
    str ByteString -> Int -> Pixel8
    `BU.unsafeIndex` Int
    readIdx
                                                 (PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) Pixel8
    byte
                                                 Int -> Int -> ST s Int
    inner (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

              filterSub :: forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterSub !PngLine s
    _previousLine !PngLine s
    thisLine = Int -> Int -> ST s Int
    inner Int
    beginZeroes
                where inner :: Int -> Int -> ST s Int
    inner Int
    idx !Int
    readIdx
                                | Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    lastIdx = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    readIdx
                                | Bool
    otherwise = do let byte :: Pixel8
    byte = ByteString
    str ByteString -> Int -> Pixel8
    `BU.unsafeIndex` Int
    readIdx
                                                 Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    stride)
                                                 (PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Pixel8
    byte Pixel8 -> Pixel8 -> Pixel8
    forall a. Num a => a -> a -> a
    + Pixel8
    val
                                                 Int -> Int -> ST s Int
    inner (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

              filterUp :: forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterUp !PngLine s
    previousLine !PngLine s
    thisLine = Int -> Int -> ST s Int
    inner Int
    beginZeroes
                where inner :: Int -> Int -> ST s Int
    inner Int
    idx !Int
    readIdx
                                | Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    lastIdx = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    readIdx
                                | Bool
    otherwise = do let byte :: Pixel8
    byte = ByteString
    str ByteString -> Int -> Pixel8
    `BU.unsafeIndex` Int
    readIdx
                                                 Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    previousLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                                                 (PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Pixel8
    val Pixel8 -> Pixel8 -> Pixel8
    forall a. Num a => a -> a -> a
    + Pixel8
    byte
                                                 Int -> Int -> ST s Int
    inner (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

              filterAverage :: forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterAverage !PngLine s
    previousLine !PngLine s
    thisLine = Int -> Int -> ST s Int
    inner Int
    beginZeroes
                where inner :: Int -> Int -> ST s Int
    inner Int
    idx !Int
    readIdx
                                | Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    lastIdx = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    readIdx
                                | Bool
    otherwise = do let byte :: Pixel8
    byte = ByteString
    str ByteString -> Int -> Pixel8
    `BU.unsafeIndex` Int
    readIdx
                                                 Pixel8
    valA <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    stride)
                                                 Pixel8
    valB <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    previousLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                                                 let a' :: Word16
    a' = Pixel8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixel8
    valA
                                                     b' :: Word16
    b' = Pixel8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixel8
    valB
                                                     average :: Pixel8
    average = Word16 -> Pixel8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word16
    a' Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    + Word16
    b') Word16 -> Word16 -> Word16
    forall a. Integral a => a -> a -> a
    `div` (Word16
    2 :: Word16))
                                                     writeVal :: Pixel8
    writeVal = Pixel8
    byte Pixel8 -> Pixel8 -> Pixel8
    forall a. Num a => a -> a -> a
    + Pixel8
    average
                                                 (PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) Pixel8
    writeVal
                                                 Int -> Int -> ST s Int
    inner (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

              filterPaeth :: forall s. PngLine s -> PngLine s -> Int -> ST s Int
    filterPaeth !PngLine s
    previousLine !PngLine s
    thisLine = Int -> Int -> ST s Int
    inner Int
    beginZeroes
                where inner :: Int -> Int -> ST s Int
    inner Int
    idx !Int
    readIdx
                                | Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    lastIdx = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    readIdx
                                | Bool
    otherwise = do let byte :: Pixel8
    byte = ByteString
    str ByteString -> Int -> Pixel8
    `BU.unsafeIndex` Int
    readIdx
                                                 Pixel8
    valA <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    stride)
                                                 Pixel8
    valC <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    previousLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    stride)
                                                 Pixel8
    valB <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    previousLine MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                                                 (PngLine s
    MVector (PrimState (ST s)) Pixel8
    thisLine MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Pixel8
    byte Pixel8 -> Pixel8 -> Pixel8
    forall a. Num a => a -> a -> a
    + Pixel8 -> Pixel8 -> Pixel8 -> Pixel8
    forall {a}. Integral a => a -> a -> a -> a
    paeth Pixel8
    valA Pixel8
    valB Pixel8
    valC
                                                 Int -> Int -> ST s Int
    inner (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

                      paeth :: a -> a -> a -> a
    paeth a
    a a
    b a
    c
                        | Int
    pa Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    pb Bool -> Bool -> Bool
    && Int
    pa Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    pc = a
    a
                        | Int
    pb Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    pc             = a
    b
                        | Bool
    otherwise            = a
    c
                          where a' :: Int
    a' = a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    a :: Int
                                b' :: Int
    b' = a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    b
                                c' :: Int
    c' = a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    c
                                p :: Int
    p = Int
    a' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    b' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    c'
                                pa :: Int
    pa = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    a'
                                pb :: Int
    pb = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    b'
                                pc :: Int
    pc = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    c'

    -- | Directly stolen from the definition in the standard (on W3C page),

    -- pixel predictor.

    type PngLine s = M.STVector s Word8
    type LineUnpacker s = Int -> (Int, PngLine s) -> ST s ()

    type StrideInfo  = (Int, Int)

    type BeginOffset = (Int, Int)

    -- | Unpack lines where bit depth is 8

    byteUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
    byteUnpacker :: forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    byteUnpacker Int
    sampleCount (MutableImage{ mutableImageWidth :: forall s a. MutableImage s a -> Int
    mutableImageWidth = Int
    imgWidth, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
    mutableImageData = STVector s (PixelBaseComponent Pixel8)
    arr })
                 (Int
    strideWidth, Int
    strideHeight) (Int
    beginLeft, Int
    beginTop) Int
    h (Int
    beginIdx, PngLine s
    line) = do
        (Int
    _, Int
    maxIdx) <- PngLine s -> ST s (Int, Int)
    forall (m :: * -> *) a s.
    (Monad m, Storable a) =>
    STVector s a -> m (Int, Int)
    getBounds PngLine s
    line
        let realTop :: Int
    realTop = Int
    beginTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideHeight
            lineIndex :: Int
    lineIndex = Int
    realTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth
            pixelToRead :: Int
    pixelToRead = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    maxIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beginIdx) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    sampleCount
            inner :: Int -> ST s ()
    inner Int
    pixelIndex | Int
    pixelIndex Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    pixelToRead = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                             | Bool
    otherwise = do
                let destPixelIndex :: Int
    destPixelIndex = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
                    destSampleIndex :: Int
    destSampleIndex = Int
    destPixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampleCount
                    srcPixelIndex :: Int
    srcPixelIndex = Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampleCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginIdx
                    perPixel :: Int -> ST s ()
    perPixel Int
    sample | Int
    sample Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    sampleCount = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                    | Bool
    otherwise = do
                        Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    srcPixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sample)
                        let writeIdx :: Int
    writeIdx = Int
    destSampleIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sample
                        (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) Pixel8
    val
                        Int -> ST s ()
    perPixel (Int
    sample Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                Int -> ST s ()
    perPixel Int
    0
                Int -> ST s ()
    inner (Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
        Int -> ST s ()
    inner Int
    0

    -- | Unpack lines where bit depth is 1

    bitUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
    bitUnpacker :: forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    bitUnpacker Int
    _ (MutableImage{ mutableImageWidth :: forall s a. MutableImage s a -> Int
    mutableImageWidth = Int
    imgWidth, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
    mutableImageData = STVector s (PixelBaseComponent Pixel8)
    arr })
                  (Int
    strideWidth, Int
    strideHeight) (Int
    beginLeft, Int
    beginTop) Int
    h (Int
    beginIdx, PngLine s
    line) = do
        (Int
    _, Int
    endLine) <- PngLine s -> ST s (Int, Int)
    forall (m :: * -> *) a s.
    (Monad m, Storable a) =>
    STVector s a -> m (Int, Int)
    getBounds PngLine s
    line
        let realTop :: Int
    realTop = Int
    beginTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideHeight
            lineIndex :: Int
    lineIndex = Int
    realTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth
            (Int
    lineWidth, Int
    subImageRest) = (Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beginLeft) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    strideWidth
            subPadd :: Int
    subPadd | Int
    subImageRest Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = Int
    1
                    | Bool
    otherwise = Int
    0
            (Int
    pixelToRead, Int
    lineRest) = (Int
    lineWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    subPadd) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    8
        [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    pixelToRead Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    pixelIndex -> do
            Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    pixelIndex  Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginIdx)
            let writeIdx :: Int -> Int
    writeIdx Int
    n = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
            [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    7] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    bit -> (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx (Int
    7 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    bit)) ((Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    bit) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    1)

        Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    lineRest Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0)
             (do Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    endLine
                 let writeIdx :: Int -> Int
    writeIdx Int
    n = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    pixelToRead Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
                 [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    lineRest Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    bit ->
                    (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    bit) ((Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` (Int
    7 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    bit)) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0x1))

    -- | Unpack lines when bit depth is 2

    twoBitsUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
    twoBitsUnpacker :: forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    twoBitsUnpacker Int
    _ (MutableImage{ mutableImageWidth :: forall s a. MutableImage s a -> Int
    mutableImageWidth = Int
    imgWidth, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
    mutableImageData = STVector s (PixelBaseComponent Pixel8)
    arr })
                      (Int
    strideWidth, Int
    strideHeight) (Int
    beginLeft, Int
    beginTop) Int
    h (Int
    beginIdx, PngLine s
    line) = do
        (Int
    _, Int
    endLine) <- PngLine s -> ST s (Int, Int)
    forall (m :: * -> *) a s.
    (Monad m, Storable a) =>
    STVector s a -> m (Int, Int)
    getBounds PngLine s
    line
        let realTop :: Int
    realTop = Int
    beginTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideHeight
            lineIndex :: Int
    lineIndex = Int
    realTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth
            (Int
    lineWidth, Int
    subImageRest) = (Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beginLeft) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    strideWidth
            subPadd :: Int
    subPadd | Int
    subImageRest Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = Int
    1
                    | Bool
    otherwise = Int
    0
            (Int
    pixelToRead, Int
    lineRest) = (Int
    lineWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    subPadd) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    4

        [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    pixelToRead Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    pixelIndex -> do
            Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    pixelIndex  Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginIdx)
            let writeIdx :: Int -> Int
    writeIdx Int
    n = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
            (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    0) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    6) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0x3
            (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    1) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0x3
            (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    2) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    2) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0x3
            (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    3) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Pixel8
    val Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0x3

        Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    lineRest Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0)
             (do Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    endLine
                 let writeIdx :: Int -> Int
    writeIdx Int
    n = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    pixelToRead Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
                 [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    lineRest Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    bit ->
                    (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    bit) ((Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` (Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    bit)) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0x3))

    halfByteUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
    halfByteUnpacker :: forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    halfByteUnpacker Int
    _ (MutableImage{ mutableImageWidth :: forall s a. MutableImage s a -> Int
    mutableImageWidth = Int
    imgWidth, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
    mutableImageData = STVector s (PixelBaseComponent Pixel8)
    arr })
                       (Int
    strideWidth, Int
    strideHeight) (Int
    beginLeft, Int
    beginTop) Int
    h (Int
    beginIdx, PngLine s
    line) = do
        (Int
    _, Int
    endLine) <- PngLine s -> ST s (Int, Int)
    forall (m :: * -> *) a s.
    (Monad m, Storable a) =>
    STVector s a -> m (Int, Int)
    getBounds PngLine s
    line
        let realTop :: Int
    realTop = Int
    beginTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideHeight
            lineIndex :: Int
    lineIndex = Int
    realTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth
            (Int
    lineWidth, Int
    subImageRest) = (Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beginLeft) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    strideWidth
            subPadd :: Int
    subPadd | Int
    subImageRest Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = Int
    1
                    | Bool
    otherwise = Int
    0
            (Int
    pixelToRead, Int
    lineRest) = (Int
    lineWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    subPadd) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    2
        [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    pixelToRead Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    pixelIndex -> do
            Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    pixelIndex  Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginIdx)
            let writeIdx :: Int -> Int
    writeIdx Int
    n = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
            (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    0) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0xF
            (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int -> Int
    writeIdx Int
    1) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Pixel8
    val Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0xF

        Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    lineRest Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0)
             (do Pixel8
    val <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    endLine
                 let writeIdx :: Int
    writeIdx = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    pixelToRead Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
                 (STVector s (PixelBaseComponent Pixel8)
    MVector (PrimState (ST s)) Pixel8
    arr MVector (PrimState (ST s)) Pixel8 -> Int -> Pixel8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) (Pixel8 -> ST s ()) -> Pixel8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (Pixel8
    val Pixel8 -> Int -> Pixel8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) Pixel8 -> Pixel8 -> Pixel8
    forall a. Bits a => a -> a -> a
    .&. Pixel8
    0xF)

    shortUnpacker :: Int -> MutableImage s Word16 -> StrideInfo -> BeginOffset -> LineUnpacker s
    shortUnpacker :: forall s.
    Int
    -> MutableImage s Word16
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    shortUnpacker Int
    sampleCount (MutableImage{ mutableImageWidth :: forall s a. MutableImage s a -> Int
    mutableImageWidth = Int
    imgWidth, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
    mutableImageData = STVector s (PixelBaseComponent Word16)
    arr })
                 (Int
    strideWidth, Int
    strideHeight) (Int
    beginLeft, Int
    beginTop) Int
    h (Int
    beginIdx, PngLine s
    line) = do
        (Int
    _, Int
    maxIdx) <- PngLine s -> ST s (Int, Int)
    forall (m :: * -> *) a s.
    (Monad m, Storable a) =>
    STVector s a -> m (Int, Int)
    getBounds PngLine s
    line
        let realTop :: Int
    realTop = Int
    beginTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideHeight
            lineIndex :: Int
    lineIndex = Int
    realTop Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth
            pixelToRead :: Int
    pixelToRead = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    maxIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beginIdx) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` (Int
    sampleCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2)
        [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    pixelToRead] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    pixelIndex -> do
            let destPixelIndex :: Int
    destPixelIndex = Int
    lineIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    strideWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginLeft
                destSampleIndex :: Int
    destSampleIndex = Int
    destPixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampleCount
                srcPixelIndex :: Int
    srcPixelIndex = Int
    pixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampleCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    beginIdx
            [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    sampleCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    sample -> do
                Pixel8
    highBits <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    srcPixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sample Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0)
                Pixel8
    lowBits <- PngLine s
    MVector (PrimState (ST s)) Pixel8
    line MVector (PrimState (ST s)) Pixel8 -> Int -> ST s Pixel8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    srcPixelIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sample Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                let fullValue :: Word16
    fullValue = Pixel8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixel8
    lowBits Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .|. (Pixel8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixel8
    highBits Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    8)
                    writeIdx :: Int
    writeIdx = Int
    destSampleIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sample
                (STVector s (PixelBaseComponent Word16)
    MVector (PrimState (ST s)) Word16
    arr MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) Word16
    fullValue

    -- | Transform a scanline to a bunch of bytes. Bytes are then packed

    -- into pixels at a further step.

    scanlineUnpacker8 :: Int -> Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset
                     -> LineUnpacker s
    scanlineUnpacker8 :: forall s.
    Int
    -> Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    scanlineUnpacker8 Int
    1 = Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    bitUnpacker
    scanlineUnpacker8 Int
    2 = Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    twoBitsUnpacker
    scanlineUnpacker8 Int
    4 = Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    halfByteUnpacker
    scanlineUnpacker8 Int
    8 = Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall s.
    Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    byteUnpacker
    scanlineUnpacker8 Int
    _ = String
    -> Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall a. HasCallStack => String -> a
    error String
    "Impossible bit depth"

    byteSizeOfBitLength :: Int -> Int -> Int -> Int
    byteSizeOfBitLength :: Int -> Int -> Int -> Int
    byteSizeOfBitLength Int
    pixelBitDepth Int
    sampleCount Int
    dimension = Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (if Int
    rest Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 then Int
    1 else Int
    0)
       where (Int
    size, Int
    rest) = (Int
    pixelBitDepth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    dimension Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampleCount) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` Int
    8

    scanLineInterleaving :: Int -> Int -> (Int, Int) -> (StrideInfo -> BeginOffset -> LineUnpacker s)
                         -> B.ByteString
                         -> ST s ()
    scanLineInterleaving :: forall s.
    Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    scanLineInterleaving Int
    depth Int
    sampleCount (Int
    imgWidth, Int
    imgHeight) (Int, Int) -> (Int, Int) -> LineUnpacker s
    unpacker ByteString
    str =
        ST s Int -> ST s ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ST s Int -> ST s ()) -> ST s Int -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ LineUnpacker s
    -> Int -> (Int, Int) -> ByteString -> Int -> ST s Int
    forall s.
    LineUnpacker s
    -> Int -> (Int, Int) -> ByteString -> Int -> ST s Int
    pngFiltering ((Int, Int) -> (Int, Int) -> LineUnpacker s
    unpacker (Int
    1,Int
    1) (Int
    0, Int
    0)) Int
    strideInfo (Int
    byteWidth, Int
    imgHeight) ByteString
    str Int
    0
            where byteWidth :: Int
    byteWidth = Int -> Int -> Int -> Int
    byteSizeOfBitLength Int
    depth Int
    sampleCount Int
    imgWidth
                  strideInfo :: Int
    strideInfo | Int
    depth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    8 = Int
    1
                             | Bool
    otherwise = Int
    sampleCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    depth Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8)

    -- | Given data and image size, recreate an image with deinterlaced

    -- data for PNG's adam 7 method.

    adam7Unpack :: Int -> Int -> (Int, Int) -> (StrideInfo -> BeginOffset -> LineUnpacker s)
                -> B.ByteString -> ST s ()
    adam7Unpack :: forall s.
    Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    adam7Unpack Int
    depth Int
    sampleCount (Int
    imgWidth, Int
    imgHeight) (Int, Int) -> (Int, Int) -> LineUnpacker s
    unpacker ByteString
    str =
      ST s () -> ST s ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (Int -> (Int -> ST s Int) -> ST s Int)
    -> Int -> [Int -> ST s Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (\Int
    i Int -> ST s Int
    f -> Int -> ST s Int
    f Int
    i) Int
    0 [Int -> ST s Int]
    subImages
        where Adam7MatrixInfo { adam7StartingRow :: Adam7MatrixInfo -> [Int]
    adam7StartingRow  = [Int]
    startRows
                              , adam7RowIncrement :: Adam7MatrixInfo -> [Int]
    adam7RowIncrement = [Int]
    rowIncrement
                              , adam7StartingCol :: Adam7MatrixInfo -> [Int]
    adam7StartingCol  = [Int]
    startCols
                              , adam7ColIncrement :: Adam7MatrixInfo -> [Int]
    adam7ColIncrement = [Int]
    colIncrement } = Adam7MatrixInfo
    adam7MatrixInfo

              subImages :: [Int -> ST s Int]
    subImages =
                  [LineUnpacker s
    -> Int -> (Int, Int) -> ByteString -> Int -> ST s Int
    forall s.
    LineUnpacker s
    -> Int -> (Int, Int) -> ByteString -> Int -> ST s Int
    pngFiltering ((Int, Int) -> (Int, Int) -> LineUnpacker s
    unpacker (Int
    incrW, Int
    incrH) (Int
    beginW, Int
    beginH)) Int
    strideInfo (Int
    byteWidth, Int
    passHeight) ByteString
    str
                                | (Int
    beginW, Int
    incrW, Int
    beginH, Int
    incrH) <- [Int] -> [Int] -> [Int] -> [Int] -> [(Int, Int, Int, Int)]
    forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
    zip4 [Int]
    startCols [Int]
    colIncrement [Int]
    startRows [Int]
    rowIncrement
                                , let passWidth :: Int
    passWidth = Int -> Int -> Int -> Int
    forall {a}. Integral a => a -> a -> a -> a
    sizer Int
    imgWidth Int
    beginW Int
    incrW
                                      passHeight :: Int
    passHeight = Int -> Int -> Int -> Int
    forall {a}. Integral a => a -> a -> a -> a
    sizer Int
    imgHeight Int
    beginH Int
    incrH
                                      byteWidth :: Int
    byteWidth = Int -> Int -> Int -> Int
    byteSizeOfBitLength Int
    depth Int
    sampleCount Int
    passWidth
                                ]
              strideInfo :: Int
    strideInfo | Int
    depth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    8 = Int
    1
                         | Bool
    otherwise = Int
    sampleCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    depth Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8)
              sizer :: a -> a -> a -> a
    sizer a
    dimension a
    begin a
    increment
                | a
    dimension a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    begin = a
    0
                | Bool
    otherwise = a
    outDim a -> a -> a
    forall a. Num a => a -> a -> a
    + (if a
    restDim a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    0 then a
    1 else a
    0)
                    where (a
    outDim, a
    restDim) = (a
    dimension a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    begin) a -> a -> (a, a)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` a
    increment

    -- | deinterlace picture in function of the method indicated

    -- in the iHDR

    deinterlacer :: PngIHdr -> B.ByteString -> ST s (Either (V.Vector Word8) (V.Vector Word16))
    deinterlacer :: forall s.
    PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    deinterlacer (PngIHdr { width :: PngIHdr -> Word32
    width = Word32
    w, height :: PngIHdr -> Word32
    height = Word32
    h, colourType :: PngIHdr -> PngImageType
    colourType  = PngImageType
    imgKind
                          , interlaceMethod :: PngIHdr -> PngInterlaceMethod
    interlaceMethod = PngInterlaceMethod
    method, bitDepth :: PngIHdr -> Pixel8
    bitDepth = Pixel8
    depth  }) ByteString
    str = do
        let compCount :: Word32
    compCount = PngImageType -> Word32
    sampleCountOfImageType PngImageType
    imgKind
            arraySize :: Int
    arraySize = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word32
    w Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    h Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    compCount
            deinterlaceFunction :: Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    deinterlaceFunction = case PngInterlaceMethod
    method of
                PngInterlaceMethod
    PngNoInterlace -> Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    forall s.
    Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    scanLineInterleaving
                PngInterlaceMethod
    PngInterlaceAdam7 -> Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    forall s.
    Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    adam7Unpack
            iBitDepth :: Int
    iBitDepth = Pixel8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Pixel8
    depth
        if Int
    iBitDepth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    8
          then do
            MVector s Pixel8
    imgArray <- Int -> ST s (MVector (PrimState (ST s)) Pixel8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new Int
    arraySize
            let mutableImage :: MutableImage s Pixel8
    mutableImage = Int
    -> Int
    -> STVector s (PixelBaseComponent Pixel8)
    -> MutableImage s Pixel8
    forall s a.
    Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
    MutableImage (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w) (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    h) MVector s Pixel8
    STVector s (PixelBaseComponent Pixel8)
    imgArray
            Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    deinterlaceFunction Int
    iBitDepth
                                (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    compCount)
                                (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w, Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    h)
                                (Int
    -> Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall s.
    Int
    -> Int
    -> MutableImage s Pixel8
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    scanlineUnpacker8 Int
    iBitDepth (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    compCount)
                                                             MutableImage s Pixel8
    mutableImage)
                                ByteString
    str
            Vector Pixel8 -> Either (Vector Pixel8) (Vector Word16)
    forall a b. a -> Either a b
    Left (Vector Pixel8 -> Either (Vector Pixel8) (Vector Word16))
    -> ST s (Vector Pixel8)
    -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVector (PrimState (ST s)) Pixel8 -> ST s (Vector Pixel8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    V.unsafeFreeze MVector s Pixel8
    MVector (PrimState (ST s)) Pixel8
    imgArray

          else do
            MVector s Word16
    imgArray <- Int -> ST s (MVector (PrimState (ST s)) Word16)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new Int
    arraySize
            let mutableImage :: MutableImage s Word16
    mutableImage = Int
    -> Int
    -> STVector s (PixelBaseComponent Word16)
    -> MutableImage s Word16
    forall s a.
    Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
    MutableImage (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w) (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    h) MVector s Word16
    STVector s (PixelBaseComponent Word16)
    imgArray
            Int
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> (Int, Int) -> LineUnpacker s)
    -> ByteString
    -> ST s ()
    deinterlaceFunction Int
    iBitDepth
                                (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    compCount)
                                (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w, Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    h)
                                (Int
    -> MutableImage s Word16
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    forall s.
    Int
    -> MutableImage s Word16
    -> (Int, Int)
    -> (Int, Int)
    -> LineUnpacker s
    shortUnpacker (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    compCount) MutableImage s Word16
    mutableImage)
                                ByteString
    str
            Vector Word16 -> Either (Vector Pixel8) (Vector Word16)
    forall a b. b -> Either a b
    Right (Vector Word16 -> Either (Vector Pixel8) (Vector Word16))
    -> ST s (Vector Word16)
    -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVector (PrimState (ST s)) Word16 -> ST s (Vector Word16)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    V.unsafeFreeze MVector s Word16
    MVector (PrimState (ST s)) Word16
    imgArray

    generateGreyscalePalette :: Word8 -> PngPalette
    generateGreyscalePalette :: Pixel8 -> PngPalette
    generateGreyscalePalette Pixel8
    bits = Int -> Vector (PixelBaseComponent PixelRGB8) -> PngPalette
    forall px. Int -> Vector (PixelBaseComponent px) -> Palette' px
    Palette' (Int
    maxValueInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Vector Pixel8
    Vector (PixelBaseComponent PixelRGB8)
    vec
        where maxValue :: Int
    maxValue = Int
    2 Int -> Pixel8 -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Pixel8
    bits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
              vec :: Vector Pixel8
    vec = Int -> [Pixel8] -> Vector Pixel8
    forall a. Storable a => Int -> [a] -> Vector a
    V.fromListN ((Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    maxValue Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3) ([Pixel8] -> Vector Pixel8) -> [Pixel8] -> Vector Pixel8
    forall a b. (a -> b) -> a -> b
    $ [[Pixel8]] -> [Pixel8]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Pixel8]]
    pixels
              pixels :: [[Pixel8]]
    pixels = [[Pixel8
    i, Pixel8
    i, Pixel8
    i] | Int
    n <- [Int
    0 .. Int
    maxValue]
                                  , let i :: Pixel8
    i = Int -> Pixel8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Pixel8) -> Int -> Pixel8
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    255 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    maxValue)]

    sampleCountOfImageType :: PngImageType -> Word32
    sampleCountOfImageType :: PngImageType -> Word32
    sampleCountOfImageType PngImageType
    PngGreyscale = Word32
    1
    sampleCountOfImageType PngImageType
    PngTrueColour = Word32
    3
    sampleCountOfImageType PngImageType
    PngIndexedColor = Word32
    1
    sampleCountOfImageType PngImageType
    PngGreyscaleWithAlpha = Word32
    2
    sampleCountOfImageType PngImageType
    PngTrueColourWithAlpha = Word32
    4

    paletteRGB1, paletteRGB2, paletteRGB4 :: PngPalette
    paletteRGB1 :: PngPalette
    paletteRGB1 = Pixel8 -> PngPalette
    generateGreyscalePalette Pixel8
    1
    paletteRGB2 :: PngPalette
    paletteRGB2 = Pixel8 -> PngPalette
    generateGreyscalePalette Pixel8
    2
    paletteRGB4 :: PngPalette
    paletteRGB4 = Pixel8 -> PngPalette
    generateGreyscalePalette Pixel8
    4

    addTransparencyToPalette :: PngPalette -> Lb.ByteString -> Palette' PixelRGBA8
    addTransparencyToPalette :: PngPalette -> ChunkSignature -> Palette' PixelRGBA8
    addTransparencyToPalette PngPalette
    pal ChunkSignature
    transpBuffer =
      Int
    -> Vector (PixelBaseComponent PixelRGBA8) -> Palette' PixelRGBA8
    forall px. Int -> Vector (PixelBaseComponent px) -> Palette' px
    Palette' (PngPalette -> Int
    forall px. Palette' px -> Int
    _paletteSize PngPalette
    pal) (Vector Pixel8 -> Palette' PixelRGBA8)
    -> (Image PixelRGB8 -> Vector Pixel8)
    -> Image PixelRGB8
    -> Palette' PixelRGBA8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGBA8 -> Vector Pixel8
    Image PixelRGBA8 -> Vector (PixelBaseComponent PixelRGBA8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData (Image PixelRGBA8 -> Vector Pixel8)
    -> (Image PixelRGB8 -> Image PixelRGBA8)
    -> Image PixelRGB8
    -> Vector Pixel8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> PixelRGB8 -> PixelRGBA8)
    -> Image PixelRGB8 -> Image PixelRGBA8
    forall a b.
    (Pixel a, Pixel b) =>
    (Int -> Int -> a -> b) -> Image a -> Image b
    pixelMapXY Int -> Int -> PixelRGB8 -> PixelRGBA8
    addOpacity (Image PixelRGB8 -> Palette' PixelRGBA8)
    -> Image PixelRGB8 -> Palette' PixelRGBA8
    forall a b. (a -> b) -> a -> b
    $ PngPalette -> Image PixelRGB8
    forall px. Palette' px -> Image px
    palettedAsImage PngPalette
    pal
      where
        maxi :: Int
    maxi = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ ChunkSignature -> Int64
    Lb.length ChunkSignature
    transpBuffer
        addOpacity :: Int -> Int -> PixelRGB8 -> PixelRGBA8
    addOpacity Int
    ix Int
    _ (PixelRGB8 Pixel8
    r Pixel8
    g Pixel8
    b) | Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    maxi =
          Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
    PixelRGBA8 Pixel8
    r Pixel8
    g Pixel8
    b (Pixel8 -> PixelRGBA8) -> Pixel8 -> PixelRGBA8
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => ChunkSignature -> Int64 -> Pixel8
    ChunkSignature -> Int64 -> Pixel8
    Lb.index ChunkSignature
    transpBuffer (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    ix)
        addOpacity Int
    _ Int
    _ (PixelRGB8 Pixel8
    r Pixel8
    g Pixel8
    b) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
    PixelRGBA8 Pixel8
    r Pixel8
    g Pixel8
    b Pixel8
    255

    unparse :: PngIHdr -> Maybe PngPalette -> [Lb.ByteString] -> PngImageType
            -> B.ByteString -> Either String PalettedImage
    unparse :: PngIHdr
    -> Maybe PngPalette
    -> [ChunkSignature]
    -> PngImageType
    -> ByteString
    -> Either String PalettedImage
    unparse PngIHdr
    ihdr Maybe PngPalette
    _ [ChunkSignature]
    t PngImageType
    PngGreyscale ByteString
    bytes
      | PngIHdr -> Pixel8
    bitDepth PngIHdr
    ihdr Pixel8 -> Pixel8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Pixel8
    1 = PngIHdr
    -> Maybe PngPalette
    -> [ChunkSignature]
    -> PngImageType
    -> ByteString
    -> Either String PalettedImage
    unparse PngIHdr
    ihdr (PngPalette -> Maybe PngPalette
    forall a. a -> Maybe a
    Just PngPalette
    paletteRGB1) [ChunkSignature]
    t PngImageType
    PngIndexedColor ByteString
    bytes
      | PngIHdr -> Pixel8
    bitDepth PngIHdr
    ihdr Pixel8 -> Pixel8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Pixel8
    2 = PngIHdr
    -> Maybe PngPalette
    -> [ChunkSignature]
    -> PngImageType
    -> ByteString
    -> Either String PalettedImage
    unparse PngIHdr
    ihdr (PngPalette -> Maybe PngPalette
    forall a. a -> Maybe a
    Just PngPalette
    paletteRGB2) [ChunkSignature]
    t PngImageType
    PngIndexedColor ByteString
    bytes
      | PngIHdr -> Pixel8
    bitDepth PngIHdr
    ihdr Pixel8 -> Pixel8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Pixel8
    4 = PngIHdr
    -> Maybe PngPalette
    -> [ChunkSignature]
    -> PngImageType
    -> ByteString
    -> Either String PalettedImage
    unparse PngIHdr
    ihdr (PngPalette -> Maybe PngPalette
    forall a. a -> Maybe a
    Just PngPalette
    paletteRGB4) [ChunkSignature]
    t PngImageType
    PngIndexedColor ByteString
    bytes
      | Bool
    otherwise =
          (DynamicImage -> PalettedImage)
    -> Either String DynamicImage -> Either String PalettedImage
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DynamicImage -> PalettedImage
    TrueColorImage (Either String DynamicImage -> Either String PalettedImage)
    -> (Either (Vector Pixel8) (Vector Word16)
        -> Either String DynamicImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PngIHdr
    -> (Image Pixel8 -> DynamicImage)
    -> (Image Word16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent Pixel8))
         (Vector (PixelBaseComponent Word16))
    -> Either String DynamicImage
    forall a pxWord8 pxWord16.
    PngIHdr
    -> (Image pxWord8 -> DynamicImage)
    -> (Image pxWord16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent pxWord8))
         (Vector (PixelBaseComponent pxWord16))
    -> Either a DynamicImage
    toImage PngIHdr
    ihdr Image Pixel8 -> DynamicImage
    ImageY8 Image Word16 -> DynamicImage
    ImageY16 (Either (Vector Pixel8) (Vector Word16)
     -> Either String PalettedImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
     -> Either (Vector Pixel8) (Vector Word16))
    -> (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a b. (a -> b) -> a -> b
    $ PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall s.
    PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    deinterlacer PngIHdr
    ihdr ByteString
    bytes

    unparse PngIHdr
    _ Maybe PngPalette
    Nothing [ChunkSignature]
    _ PngImageType
    PngIndexedColor  ByteString
    _ = String -> Either String PalettedImage
    forall a b. a -> Either a b
    Left String
    "no valid palette found"
    unparse PngIHdr
    ihdr Maybe PngPalette
    _ [ChunkSignature]
    _ PngImageType
    PngTrueColour          ByteString
    bytes =
      (DynamicImage -> PalettedImage)
    -> Either String DynamicImage -> Either String PalettedImage
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DynamicImage -> PalettedImage
    TrueColorImage (Either String DynamicImage -> Either String PalettedImage)
    -> (Either (Vector Pixel8) (Vector Word16)
        -> Either String DynamicImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PngIHdr
    -> (Image PixelRGB8 -> DynamicImage)
    -> (Image PixelRGB16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent PixelRGB8))
         (Vector (PixelBaseComponent PixelRGB16))
    -> Either String DynamicImage
    forall a pxWord8 pxWord16.
    PngIHdr
    -> (Image pxWord8 -> DynamicImage)
    -> (Image pxWord16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent pxWord8))
         (Vector (PixelBaseComponent pxWord16))
    -> Either a DynamicImage
    toImage PngIHdr
    ihdr Image PixelRGB8 -> DynamicImage
    ImageRGB8 Image PixelRGB16 -> DynamicImage
    ImageRGB16 (Either (Vector Pixel8) (Vector Word16)
     -> Either String PalettedImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
     -> Either (Vector Pixel8) (Vector Word16))
    -> (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a b. (a -> b) -> a -> b
    $ PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall s.
    PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    deinterlacer PngIHdr
    ihdr ByteString
    bytes
    unparse PngIHdr
    ihdr Maybe PngPalette
    _ [ChunkSignature]
    _ PngImageType
    PngGreyscaleWithAlpha  ByteString
    bytes =
      (DynamicImage -> PalettedImage)
    -> Either String DynamicImage -> Either String PalettedImage
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DynamicImage -> PalettedImage
    TrueColorImage (Either String DynamicImage -> Either String PalettedImage)
    -> (Either (Vector Pixel8) (Vector Word16)
        -> Either String DynamicImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PngIHdr
    -> (Image PixelYA8 -> DynamicImage)
    -> (Image PixelYA16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent PixelYA8))
         (Vector (PixelBaseComponent PixelYA16))
    -> Either String DynamicImage
    forall a pxWord8 pxWord16.
    PngIHdr
    -> (Image pxWord8 -> DynamicImage)
    -> (Image pxWord16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent pxWord8))
         (Vector (PixelBaseComponent pxWord16))
    -> Either a DynamicImage
    toImage PngIHdr
    ihdr Image PixelYA8 -> DynamicImage
    ImageYA8 Image PixelYA16 -> DynamicImage
    ImageYA16 (Either (Vector Pixel8) (Vector Word16)
     -> Either String PalettedImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
     -> Either (Vector Pixel8) (Vector Word16))
    -> (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a b. (a -> b) -> a -> b
    $ PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall s.
    PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    deinterlacer PngIHdr
    ihdr ByteString
    bytes
    unparse PngIHdr
    ihdr Maybe PngPalette
    _ [ChunkSignature]
    _ PngImageType
    PngTrueColourWithAlpha ByteString
    bytes =
      (DynamicImage -> PalettedImage)
    -> Either String DynamicImage -> Either String PalettedImage
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DynamicImage -> PalettedImage
    TrueColorImage (Either String DynamicImage -> Either String PalettedImage)
    -> (Either (Vector Pixel8) (Vector Word16)
        -> Either String DynamicImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PngIHdr
    -> (Image PixelRGBA8 -> DynamicImage)
    -> (Image PixelRGBA16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent PixelRGBA8))
         (Vector (PixelBaseComponent PixelRGBA16))
    -> Either String DynamicImage
    forall a pxWord8 pxWord16.
    PngIHdr
    -> (Image pxWord8 -> DynamicImage)
    -> (Image pxWord16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent pxWord8))
         (Vector (PixelBaseComponent pxWord16))
    -> Either a DynamicImage
    toImage PngIHdr
    ihdr Image PixelRGBA8 -> DynamicImage
    ImageRGBA8 Image PixelRGBA16 -> DynamicImage
    ImageRGBA16 (Either (Vector Pixel8) (Vector Word16)
     -> Either String PalettedImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
     -> Either (Vector Pixel8) (Vector Word16))
    -> (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a b. (a -> b) -> a -> b
    $ PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall s.
    PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    deinterlacer PngIHdr
    ihdr ByteString
    bytes
    unparse PngIHdr
    ihdr (Just PngPalette
    plte) [ChunkSignature]
    transparency PngImageType
    PngIndexedColor ByteString
    bytes =
      PngIHdr
    -> PngPalette
    -> [ChunkSignature]
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall t.
    PngIHdr
    -> PngPalette
    -> [ChunkSignature]
    -> Either (Vector Pixel8) t
    -> Either String PalettedImage
    palette8 PngIHdr
    ihdr PngPalette
    plte [ChunkSignature]
    transparency (Either (Vector Pixel8) (Vector Word16)
     -> Either String PalettedImage)
    -> Either (Vector Pixel8) (Vector Word16)
    -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
     -> Either (Vector Pixel8) (Vector Word16))
    -> (forall s. ST s (Either (Vector Pixel8) (Vector Word16)))
    -> Either (Vector Pixel8) (Vector Word16)
    forall a b. (a -> b) -> a -> b
    $ PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    forall s.
    PngIHdr
    -> ByteString -> ST s (Either (Vector Pixel8) (Vector Word16))
    deinterlacer PngIHdr
    ihdr ByteString
    bytes

    toImage :: forall a pxWord8 pxWord16
             . PngIHdr
            -> (Image pxWord8 -> DynamicImage) -> (Image pxWord16 -> DynamicImage)
            -> Either (V.Vector (PixelBaseComponent pxWord8))
                      (V.Vector (PixelBaseComponent pxWord16))
            -> Either a DynamicImage
    toImage :: forall a pxWord8 pxWord16.
    PngIHdr
    -> (Image pxWord8 -> DynamicImage)
    -> (Image pxWord16 -> DynamicImage)
    -> Either
         (Vector (PixelBaseComponent pxWord8))
         (Vector (PixelBaseComponent pxWord16))
    -> Either a DynamicImage
    toImage PngIHdr
    hdr Image pxWord8 -> DynamicImage
    const1 Image pxWord16 -> DynamicImage
    const2 Either
      (Vector (PixelBaseComponent pxWord8))
      (Vector (PixelBaseComponent pxWord16))
    lr = DynamicImage -> Either a DynamicImage
    forall a b. b -> Either a b
    Right (DynamicImage -> Either a DynamicImage)
    -> DynamicImage -> Either a DynamicImage
    forall a b. (a -> b) -> a -> b
    $ case Either
      (Vector (PixelBaseComponent pxWord8))
      (Vector (PixelBaseComponent pxWord16))
    lr of
        Left Vector (PixelBaseComponent pxWord8)
    a -> Image pxWord8 -> DynamicImage
    const1 (Image pxWord8 -> DynamicImage) -> Image pxWord8 -> DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector (PixelBaseComponent pxWord8) -> Image pxWord8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector (PixelBaseComponent pxWord8)
    a
        Right Vector (PixelBaseComponent pxWord16)
    a -> Image pxWord16 -> DynamicImage
    const2 (Image pxWord16 -> DynamicImage) -> Image pxWord16 -> DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int -> Vector (PixelBaseComponent pxWord16) -> Image pxWord16
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector (PixelBaseComponent pxWord16)
    a
      where
        w :: Int
    w = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ PngIHdr -> Word32
    width PngIHdr
    hdr
        h :: Int
    h = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ PngIHdr -> Word32
    height PngIHdr
    hdr

    palette8 :: PngIHdr -> PngPalette -> [Lb.ByteString] -> Either (V.Vector Word8) t
             -> Either String PalettedImage
    palette8 :: forall t.
    PngIHdr
    -> PngPalette
    -> [ChunkSignature]
    -> Either (Vector Pixel8) t
    -> Either String PalettedImage
    palette8 PngIHdr
    hdr PngPalette
    palette [ChunkSignature]
    transparency Either (Vector Pixel8) t
    eimg = case ([ChunkSignature]
    transparency, Either (Vector Pixel8) t
    eimg) of
      ([ChunkSignature
    c], Left Vector Pixel8
    img) ->
        PalettedImage -> Either String PalettedImage
    forall a b. b -> Either a b
    Right (PalettedImage -> Either String PalettedImage)
    -> (Palette' PixelRGBA8 -> PalettedImage)
    -> Palette' PixelRGBA8
    -> Either String PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image Pixel8 -> Palette' PixelRGBA8 -> PalettedImage
    PalettedRGBA8 (Int -> Int -> Vector (PixelBaseComponent Pixel8) -> Image Pixel8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Pixel8
    Vector (PixelBaseComponent Pixel8)
    img) (Palette' PixelRGBA8 -> Either String PalettedImage)
    -> Palette' PixelRGBA8 -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ PngPalette -> ChunkSignature -> Palette' PixelRGBA8
    addTransparencyToPalette PngPalette
    palette ChunkSignature
    c
      ([ChunkSignature]
    _, Left Vector Pixel8
    img) ->
        PalettedImage -> Either String PalettedImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Either String PalettedImage)
    -> PalettedImage -> Either String PalettedImage
    forall a b. (a -> b) -> a -> b
    $ Image Pixel8 -> PngPalette -> PalettedImage
    PalettedRGB8 (Int -> Int -> Vector (PixelBaseComponent Pixel8) -> Image Pixel8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Pixel8
    Vector (PixelBaseComponent Pixel8)
    img) PngPalette
    palette
      ([ChunkSignature]
    _, Right t
    _) ->
        String -> Either String PalettedImage
    forall a b. a -> Either a b
    Left String
    "Invalid bit depth for paleted image"
      where
        w :: Int
    w = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ PngIHdr -> Word32
    width PngIHdr
    hdr
        h :: Int
    h = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ PngIHdr -> Word32
    height PngIHdr
    hdr

    -- | Transform a raw png image to an image, without modifying the

    -- underlying pixel type. If the image is greyscale and < 8 bits,

    -- a transformation to RGBA8 is performed. This should change

    -- in the future.

    -- The resulting image let you manage the pixel types.

    --

    -- This function can output the following images:

    --

    --  * 'ImageY8'

    --

    --  * 'ImageY16'

    --

    --  * 'ImageYA8'

    --

    --  * 'ImageYA16'

    --

    --  * 'ImageRGB8'

    --

    --  * 'ImageRGB16'

    --

    --  * 'ImageRGBA8'

    --

    --  * 'ImageRGBA16'

    --

    decodePng :: B.ByteString -> Either String DynamicImage
    decodePng :: ByteString -> Either String DynamicImage
    decodePng = ((DynamicImage, Metadatas) -> DynamicImage)
    -> Either String (DynamicImage, Metadatas)
    -> Either String DynamicImage
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (DynamicImage, Metadatas) -> DynamicImage
    forall a b. (a, b) -> a
    fst (Either String (DynamicImage, Metadatas)
     -> Either String DynamicImage)
    -> (ByteString -> Either String (DynamicImage, Metadatas))
    -> ByteString
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either String (DynamicImage, Metadatas)
    decodePngWithMetadata

    -- | Decode a PNG file with, possibly, separated palette.

    decodePngWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
    decodePngWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
    decodePngWithMetadata ByteString
    b = (PalettedImage -> DynamicImage)
    -> (PalettedImage, Metadatas) -> (DynamicImage, Metadatas)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first PalettedImage -> DynamicImage
    palettedToTrueColor ((PalettedImage, Metadatas) -> (DynamicImage, Metadatas))
    -> Either String (PalettedImage, Metadatas)
    -> Either String (DynamicImage, Metadatas)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> Either String (PalettedImage, Metadatas)
    decodePngWithPaletteAndMetadata ByteString
    b

    -- | Same as 'decodePng' but also extract meta datas present

    -- in the files.

    decodePngWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
    decodePngWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
    decodePngWithPaletteAndMetadata ByteString
    byte =  do
      PngRawImage
    rawImg <- Get PngRawImage -> ByteString -> Either String PngRawImage
    forall a. Get a -> ByteString -> Either String a
    runGetStrict Get PngRawImage
    forall t. Binary t => Get t
    get ByteString
    byte
      let ihdr :: PngIHdr
    ihdr = PngRawImage -> PngIHdr
    header PngRawImage
    rawImg
          metadatas :: Metadatas
    metadatas =
             SourceFormat -> Word32 -> Word32 -> Metadatas
    forall nSize.
    Integral nSize =>
    SourceFormat -> nSize -> nSize -> Metadatas
    basicMetadata SourceFormat
    SourcePng (PngIHdr -> Word32
    width PngIHdr
    ihdr) (PngIHdr -> Word32
    height PngIHdr
    ihdr) Metadatas -> Metadatas -> Metadatas
    forall a. Semigroup a => a -> a -> a
    <> PngRawImage -> Metadatas
    extractMetadatas PngRawImage
    rawImg
          compressedImageData :: ChunkSignature
    compressedImageData =
                [ChunkSignature] -> ChunkSignature
    Lb.concat [PngRawChunk -> ChunkSignature
    chunkData PngRawChunk
    chunk | PngRawChunk
    chunk <- PngRawImage -> [PngRawChunk]
    chunks PngRawImage
    rawImg
                                           , PngRawChunk -> ChunkSignature
    chunkType PngRawChunk
    chunk ChunkSignature -> ChunkSignature -> Bool
    forall a. Eq a => a -> a -> Bool
    == ChunkSignature
    iDATSignature]
          zlibHeaderSize :: Int64
    zlibHeaderSize = Int64
    1 {- compression method/flags code -}
                         Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    1 {- Additional flags/check bits -}
                         Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    4 {-CRC-}

          transparencyColor :: [ChunkSignature]
    transparencyColor =
              [ PngRawChunk -> ChunkSignature
    chunkData PngRawChunk
    chunk | PngRawChunk
    chunk <- PngRawImage -> [PngRawChunk]
    chunks PngRawImage
    rawImg
                                , PngRawChunk -> ChunkSignature
    chunkType PngRawChunk
    chunk ChunkSignature -> ChunkSignature -> Bool
    forall a. Eq a => a -> a -> Bool
    == ChunkSignature
    tRNSSignature ]

      if ChunkSignature -> Int64
    Lb.length ChunkSignature
    compressedImageData Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    zlibHeaderSize then
        String -> Either String (PalettedImage, Metadatas)
    forall a b. a -> Either a b
    Left String
    "Invalid data size"
      else
        let imgData :: ChunkSignature
    imgData = ChunkSignature -> ChunkSignature
    Z.decompress ChunkSignature
    compressedImageData
            parseableData :: ByteString
    parseableData = [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ChunkSignature -> [ByteString]
    Lb.toChunks ChunkSignature
    imgData
            palette :: Maybe PngPalette
    palette = do
              PngRawChunk
    p <- (PngRawChunk -> Bool) -> [PngRawChunk] -> Maybe PngRawChunk
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\PngRawChunk
    c -> ChunkSignature
    pLTESignature ChunkSignature -> ChunkSignature -> Bool
    forall a. Eq a => a -> a -> Bool
    == PngRawChunk -> ChunkSignature
    chunkType PngRawChunk
    c) ([PngRawChunk] -> Maybe PngRawChunk)
    -> [PngRawChunk] -> Maybe PngRawChunk
    forall a b. (a -> b) -> a -> b
    $ PngRawImage -> [PngRawChunk]
    chunks PngRawImage
    rawImg
              case PngRawChunk -> Either String PngPalette
    parsePalette PngRawChunk
    p of
                Left String
    _ -> Maybe PngPalette
    forall a. Maybe a
    Nothing
                Right PngPalette
    plte -> PngPalette -> Maybe PngPalette
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PngPalette
    plte
        in
        (, Metadatas
    metadatas) (PalettedImage -> (PalettedImage, Metadatas))
    -> Either String PalettedImage
    -> Either String (PalettedImage, Metadatas)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            PngIHdr
    -> Maybe PngPalette
    -> [ChunkSignature]
    -> PngImageType
    -> ByteString
    -> Either String PalettedImage
    unparse PngIHdr
    ihdr Maybe PngPalette
    palette [ChunkSignature]
    transparencyColor (PngIHdr -> PngImageType
    colourType PngIHdr
    ihdr) ByteString
    parseableData

    {-# ANN module "HLint: ignore Reduce duplication" #-}