    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -fspec-constr-count=5 #-}
    -- | Module used for JPEG file loading and writing.

    module Codec.Picture.Jpg( decodeJpeg
                            , decodeJpegWithMetadata
                            , encodeJpegAtQuality
                            , encodeJpegAtQualityWithMetadata
                            , encodeDirectJpegAtQualityWithMetadata
                            , encodeJpeg
                            , JpgEncodable
                            ) where

    #if !MIN_VERSION_base(4,8,0)
    import Data.Foldable( foldMap )
    import Data.Monoid( mempty )
    import Control.Applicative( pure, (<$>) )
    #endif

    import Control.Applicative( (<|>) )

    import Control.Arrow( (>>>) )
    import Control.Monad( when, forM_ )
    import Control.Monad.ST( ST, runST )
    import Control.Monad.Trans( lift )
    import Control.Monad.Trans.RWS.Strict( RWS, modify, tell, gets, execRWS )

    import Data.Bits( (.|.), unsafeShiftL )
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid( (<>) )
    #endif
    import Data.Int( Int16, Int32 )
    import Data.Word(Word8, Word32)
    import Data.Binary( Binary(..), encode )
    import Data.STRef( newSTRef, writeSTRef, readSTRef )

    import Data.Vector( (//) )
    import Data.Vector.Unboxed( (!) )
    import qualified Data.Vector as V
    import qualified Data.Vector.Unboxed as VU
    import qualified Data.Vector.Storable as VS
    import qualified Data.Vector.Storable.Mutable as M
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as L

    import Codec.Picture.InternalHelper
    import Codec.Picture.BitWriter
    import Codec.Picture.Types
    import Codec.Picture.Metadata( Metadatas
                                 , SourceFormat( SourceJpeg )
                                 , basicMetadata )
    import Codec.Picture.Tiff.Internal.Types
    import Codec.Picture.Tiff.Internal.Metadata
    import Codec.Picture.Jpg.Internal.Types
    import Codec.Picture.Jpg.Internal.Common
    import Codec.Picture.Jpg.Internal.Progressive
    import Codec.Picture.Jpg.Internal.DefaultTable
    import Codec.Picture.Jpg.Internal.FastDct
    import Codec.Picture.Jpg.Internal.Metadata

    quantize :: MacroBlock Int16 -> MutableMacroBlock s Int32
             -> ST s (MutableMacroBlock s Int32)
    quantize :: forall s.
    MacroBlock Int16
    -> MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32)
    quantize MacroBlock Int16
    table MutableMacroBlock s Int32
    block = Int -> ST s (MutableMacroBlock s Int32)
    update Int
    0
      where update :: Int -> ST s (MutableMacroBlock s Int32)
    update Int
    64 = MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MutableMacroBlock s Int32
    block
            update Int
    idx = do
                Int32
    val <- MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    block MVector (PrimState (ST s)) Int32 -> Int -> ST s Int32
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                let q :: Int32
    q = Int16 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (MacroBlock Int16
    table MacroBlock Int16 -> Int -> Int16
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` Int
    idx)
                    finalValue :: Int32
    finalValue = (Int32
    val Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    + (Int32
    q Int32 -> Int32 -> Int32
    forall a. Integral a => a -> a -> a
    `div` Int32
    2)) Int32 -> Int32 -> Int32
    forall a. Integral a => a -> a -> a
    `quot` Int32
    q -- rounded integer division

                (MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    block MVector (PrimState (ST s)) Int32 -> Int -> Int32 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) Int32
    finalValue
                Int -> ST s (MutableMacroBlock s Int32)
    update (Int -> ST s (MutableMacroBlock s Int32))
    -> Int -> ST s (MutableMacroBlock s Int32)
    forall a b. (a -> b) -> a -> b
    $ Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

    powerOf :: Int32 -> Word32
    powerOf :: Int32 -> Word32
    powerOf Int32
    0 = Word32
    0
    powerOf Int32
    n = Int32 -> Word32 -> Word32
    limit Int32
    1 Word32
    0
        where val :: Int32
    val = Int32 -> Int32
    forall a. Num a => a -> a
    abs Int32
    n
              limit :: Int32 -> Word32 -> Word32
    limit Int32
    range Word32
    i | Int32
    val Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int32
    range = Word32
    i
              limit Int32
    range Word32
    i = Int32 -> Word32 -> Word32
    limit (Int32
    2 Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32
    range) (Word32
    i Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    1)

    encodeInt :: BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
    {-# INLINE encodeInt #-}
    encodeInt :: forall s. BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
    encodeInt BoolWriteStateRef s
    st Word32
    ssss Int32
    n | Int32
    n Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int32
    0 = BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    writeBits' BoolWriteStateRef s
    st (Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    n) (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    ssss)
    encodeInt BoolWriteStateRef s
    st Word32
    ssss Int32
    n         = BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    writeBits' BoolWriteStateRef s
    st (Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Word32) -> Int32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int32
    n Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    - Int32
    1) (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    ssss)

    -- | Assume the macro block is initialized with zeroes

    acCoefficientsDecode :: HuffmanPackedTree -> MutableMacroBlock s Int16
                         -> BoolReader s (MutableMacroBlock s Int16)
    acCoefficientsDecode :: forall s.
    HuffmanPackedTree
    -> MutableMacroBlock s Int16
    -> BoolReader s (MutableMacroBlock s Int16)
    acCoefficientsDecode HuffmanPackedTree
    acTree MutableMacroBlock s Int16
    mutableBlock = Int -> StateT BoolState (ST s) ()
    parseAcCoefficient Int
    1 StateT BoolState (ST s) ()
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    forall a b.
    StateT BoolState (ST s) a
    -> StateT BoolState (ST s) b -> StateT BoolState (ST s) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> MutableMacroBlock s Int16
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    forall a. a -> StateT BoolState (ST s) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MutableMacroBlock s Int16
    mutableBlock
      where parseAcCoefficient :: Int -> StateT BoolState (ST s) ()
    parseAcCoefficient Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    64 = () -> StateT BoolState (ST s) ()
    forall a. a -> StateT BoolState (ST s) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                 | Bool
    otherwise = do
                (Int, Int)
    rrrrssss <- HuffmanPackedTree -> BoolReader s (Int, Int)
    forall s. HuffmanPackedTree -> BoolReader s (Int, Int)
    decodeRrrrSsss HuffmanPackedTree
    acTree
                case (Int, Int)
    rrrrssss of
                    (  Int
    0, Int
    0) -> () -> StateT BoolState (ST s) ()
    forall a. a -> StateT BoolState (ST s) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    (Int
    0xF, Int
    0) -> Int -> StateT BoolState (ST s) ()
    parseAcCoefficient (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    16)
                    (Int
    rrrr, Int
    ssss) -> do
                        Int16
    decoded <- Int32 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int16)
    -> StateT BoolState (ST s) Int32 -> StateT BoolState (ST s) Int16
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> StateT BoolState (ST s) Int32
    forall s. Int -> BoolReader s Int32
    decodeInt Int
    ssss
                        ST s () -> StateT BoolState (ST s) ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> StateT BoolState (ST s) ())
    -> ST s () -> StateT BoolState (ST s) ()
    forall a b. (a -> b) -> a -> b
    $ (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    mutableBlock MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rrrr)) Int16
    decoded
                        Int -> StateT BoolState (ST s) ()
    parseAcCoefficient (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    rrrr Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

    -- | Decompress a macroblock from a bitstream given the current configuration

    -- from the frame.

    decompressMacroBlock :: HuffmanPackedTree   -- ^ Tree used for DC coefficient

                         -> HuffmanPackedTree   -- ^ Tree used for Ac coefficient

                         -> MacroBlock Int16    -- ^ Current quantization table

                         -> MutableMacroBlock s Int16    -- ^ A zigzag table, to avoid allocation

                         -> DcCoefficient       -- ^ Previous dc value

                         -> BoolReader s (DcCoefficient, MutableMacroBlock s Int16)
    decompressMacroBlock :: forall s.
    HuffmanPackedTree
    -> HuffmanPackedTree
    -> MacroBlock Int16
    -> MutableMacroBlock s Int16
    -> Int16
    -> BoolReader s (Int16, MutableMacroBlock s Int16)
    decompressMacroBlock HuffmanPackedTree
    dcTree HuffmanPackedTree
    acTree MacroBlock Int16
    quantizationTable MutableMacroBlock s Int16
    zigzagBlock Int16
    previousDc = do
        Int16
    dcDeltaCoefficient <- HuffmanPackedTree -> BoolReader s Int16
    forall s. HuffmanPackedTree -> BoolReader s Int16
    dcCoefficientDecode HuffmanPackedTree
    dcTree
        MutableMacroBlock s Int16
    block <- ST s (MutableMacroBlock s Int16)
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift ST s (MutableMacroBlock s Int16)
    forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock
        let neoDcCoefficient :: Int16
    neoDcCoefficient = Int16
    previousDc Int16 -> Int16 -> Int16
    forall a. Num a => a -> a -> a
    + Int16
    dcDeltaCoefficient
        ST s () -> StateT BoolState (ST s) ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> StateT BoolState (ST s) ())
    -> ST s () -> StateT BoolState (ST s) ()
    forall a b. (a -> b) -> a -> b
    $ (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    0) Int16
    neoDcCoefficient
        MutableMacroBlock s Int16
    fullBlock <- HuffmanPackedTree
    -> MutableMacroBlock s Int16
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    forall s.
    HuffmanPackedTree
    -> MutableMacroBlock s Int16
    -> BoolReader s (MutableMacroBlock s Int16)
    acCoefficientsDecode HuffmanPackedTree
    acTree MutableMacroBlock s Int16
    block
        MutableMacroBlock s Int16
    decodedBlock <- ST s (MutableMacroBlock s Int16)
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s (MutableMacroBlock s Int16)
     -> StateT BoolState (ST s) (MutableMacroBlock s Int16))
    -> ST s (MutableMacroBlock s Int16)
    -> StateT BoolState (ST s) (MutableMacroBlock s Int16)
    forall a b. (a -> b) -> a -> b
    $ MacroBlock Int16
    -> MutableMacroBlock s Int16
    -> MutableMacroBlock s Int16
    -> ST s (MutableMacroBlock s Int16)
    forall s.
    MacroBlock Int16
    -> MutableMacroBlock s Int16
    -> MutableMacroBlock s Int16
    -> ST s (MutableMacroBlock s Int16)
    decodeMacroBlock MacroBlock Int16
    quantizationTable MutableMacroBlock s Int16
    zigzagBlock MutableMacroBlock s Int16
    fullBlock
        (Int16, MutableMacroBlock s Int16)
    -> BoolReader s (Int16, MutableMacroBlock s Int16)
    forall a. a -> StateT BoolState (ST s) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int16
    neoDcCoefficient, MutableMacroBlock s Int16
    decodedBlock)

    pixelClamp :: Int16 -> Word8
    pixelClamp :: Int16 -> Word8
    pixelClamp Int16
    n = Int16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int16 -> Word8) -> (Int16 -> Int16) -> Int16 -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int16 -> Int16 -> Int16
    forall a. Ord a => a -> a -> a
    min Int16
    255 (Int16 -> Word8) -> Int16 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int16 -> Int16 -> Int16
    forall a. Ord a => a -> a -> a
    max Int16
    0 Int16
    n

    unpack444Y :: Int -- ^ component index

               -> Int -- ^ x

               -> Int -- ^ y

               -> MutableImage s PixelYCbCr8
               -> MutableMacroBlock s Int16
               -> ST s ()
    unpack444Y :: forall s.
    Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpack444Y Int
    _ Int
    x Int
    y (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 PixelYCbCr8)
    img })
                     MutableMacroBlock s Int16
    block = Int -> Int -> Int -> ST s ()
    blockVert Int
    baseIdx Int
    0 Int
    zero
      where zero :: Int
    zero = Int
    0 :: Int
            baseIdx :: Int
    baseIdx = Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth

            blockVert :: Int -> Int -> Int -> ST s ()
    blockVert        Int
    _       Int
    _ Int
    j | Int
    j Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    forall a. Num a => a
    dctBlockSize = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            blockVert Int
    writeIdx Int
    readingIdx Int
    j = Int -> Int -> Int -> ST s ()
    blockHoriz Int
    writeIdx Int
    readingIdx Int
    zero
              where blockHoriz :: Int -> Int -> Int -> ST s ()
    blockHoriz   Int
    _ Int
    readIdx Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    forall a. Num a => a
    dctBlockSize = Int -> Int -> Int -> ST s ()
    blockVert (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    imgWidth) Int
    readIdx (Int -> ST s ()) -> Int -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                    blockHoriz Int
    idx Int
    readIdx Int
    i = do
                        Word8
    val <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    readIdx)
                        (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) Word8
    val
                        Int -> Int -> Int -> ST s ()
    blockHoriz (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> ST s ()) -> Int -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

    unpack444Ycbcr :: Int -- ^ Component index

                  -> Int -- ^ x

                  -> Int -- ^ y

                  -> MutableImage s PixelYCbCr8
                  -> MutableMacroBlock s Int16
                  -> ST s ()
    unpack444Ycbcr :: forall s.
    Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpack444Ycbcr Int
    compIdx Int
    x Int
    y
                     (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 PixelYCbCr8)
    img })
                     MutableMacroBlock s Int16
    block = Int -> Int -> Int -> ST s ()
    blockVert Int
    baseIdx Int
    0 Int
    zero
      where zero :: Int
    zero = Int
    0 :: Int
            baseIdx :: Int
    baseIdx = (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    compIdx

            blockVert :: Int -> Int -> Int -> ST s ()
    blockVert   Int
    _       Int
    _ Int
    j | Int
    j Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    forall a. Num a => a
    dctBlockSize = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            blockVert Int
    idx Int
    readIdx Int
    j = do
                Word8
    val0 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    readIdx)
                Word8
    val1 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
                Word8
    val2 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2))
                Word8
    val3 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))
                Word8
    val4 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4))
                Word8
    val5 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    5))
                Word8
    val6 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6))
                Word8
    val7 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7))

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx) Word8
    val0
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +  Int
    3     )) Word8
    val1
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2))) Word8
    val2
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3))) Word8
    val3
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4))) Word8
    val4
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    5))) Word8
    val5
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    6))) Word8
    val6
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    7))) Word8
    val7

                Int -> Int -> Int -> ST s ()
    blockVert (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth) (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    forall a. Num a => a
    dctBlockSize) (Int -> ST s ()) -> Int -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

              {-where blockHoriz   _ readIdx i | i >= 8 = blockVert (writeIdx + imgWidth * 3) readIdx $ j + 1-}
                    {-blockHoriz idx readIdx i = do-}
                        {-val <- pixelClamp <$> (block `M.unsafeRead` readIdx) -}
                        {-(img `M.unsafeWrite` idx) val-}
                        {-blockHoriz (idx + 3) (readIdx + 1) $ i + 1-}

    unpack421Ycbcr :: Int -- ^ Component index

                   -> Int -- ^ x

                   -> Int -- ^ y

                   -> MutableImage s PixelYCbCr8
                   -> MutableMacroBlock s Int16
                   -> ST s ()
    unpack421Ycbcr :: forall s.
    Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpack421Ycbcr Int
    compIdx Int
    x Int
    y
                     (MutableImage { mutableImageWidth :: forall s a. MutableImage s a -> Int
    mutableImageWidth = Int
    imgWidth,
                                     mutableImageHeight :: forall s a. MutableImage s a -> Int
    mutableImageHeight = Int
    _, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
    mutableImageData = STVector s (PixelBaseComponent PixelYCbCr8)
    img })
                     MutableMacroBlock s Int16
    block = Int -> Int -> Int -> ST s ()
    blockVert Int
    baseIdx Int
    0 Int
    zero
      where zero :: Int
    zero = Int
    0 :: Int
            baseIdx :: Int
    baseIdx = (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    compIdx
            lineOffset :: Int
    lineOffset = Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3

            blockVert :: Int -> Int -> Int -> ST s ()
    blockVert        Int
    _       Int
    _ Int
    j | Int
    j Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    forall a. Num a => a
    dctBlockSize = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            blockVert Int
    idx Int
    readIdx Int
    j = do
                Word8
    v0 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    readIdx)
                Word8
    v1 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
                Word8
    v2 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2))
                Word8
    v3 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))
                Word8
    v4 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4))
                Word8
    v5 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    5))
                Word8
    v6 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6))
                Word8
    v7 <- Int16 -> Word8
    pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7))

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    idx)       Word8
    v0
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)) Word8
    v0

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6    ))      Word8
    v1
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6     Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))  Word8
    v1

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2))      Word8
    v2
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 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
    3))  Word8
    v2

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3))      Word8
    v3
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))  Word8
    v3

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4))      Word8
    v4
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))  Word8
    v4

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    5))      Word8
    v5
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    5 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))  Word8
    v5

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    6))      Word8
    v6
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))  Word8
    v6

                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    7))      Word8
    v7
                (STVector s (PixelBaseComponent PixelYCbCr8)
    MVector (PrimState (ST s)) Word8
    img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    6 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    7 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3))  Word8
    v7

                Int -> Int -> Int -> ST s ()
    blockVert (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lineOffset) (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    forall a. Num a => a
    dctBlockSize) (Int -> ST s ()) -> Int -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

    type Unpacker s = Int -- ^ component index

                   -> Int -- ^ x

                   -> Int -- ^ y

                   -> MutableImage s PixelYCbCr8
                   -> MutableMacroBlock s Int16
                   -> ST s ()

    type JpgScripter s a =
        RWS () [([(JpgUnpackerParameter, Unpacker s)], L.ByteString)] JpgDecoderState a

    data JpgDecoderState = JpgDecoderState
        { JpgDecoderState -> Vector HuffmanPackedTree
    dcDecoderTables       :: !(V.Vector HuffmanPackedTree)
        , JpgDecoderState -> Vector HuffmanPackedTree
    acDecoderTables       :: !(V.Vector HuffmanPackedTree)
        , JpgDecoderState -> Vector (MacroBlock Int16)
    quantizationMatrices  :: !(V.Vector (MacroBlock Int16))
        , JpgDecoderState -> Int
    currentRestartInterv  :: !Int
        , JpgDecoderState -> Maybe JpgFrameHeader
    currentFrame          :: Maybe JpgFrameHeader
        , JpgDecoderState -> Maybe JpgAdobeApp14
    app14Marker           :: !(Maybe JpgAdobeApp14)
        , JpgDecoderState -> Maybe JpgJFIFApp0
    app0JFifMarker        :: !(Maybe JpgJFIFApp0)
        , JpgDecoderState -> Maybe [ImageFileDirectory]
    app1ExifMarker        :: !(Maybe [ImageFileDirectory])
        , JpgDecoderState -> [(Word8, Int)]
    componentIndexMapping :: ![(Word8, Int)]
        , JpgDecoderState -> Bool
    isProgressive         :: !Bool
        , JpgDecoderState -> Int
    maximumHorizontalResolution :: !Int
        , JpgDecoderState -> Int
    maximumVerticalResolution   :: !Int
        , JpgDecoderState -> Int
    seenBlobs                   :: !Int
        }

    emptyDecoderState :: JpgDecoderState
    emptyDecoderState :: JpgDecoderState
    emptyDecoderState = JpgDecoderState
        { dcDecoderTables :: Vector HuffmanPackedTree
    dcDecoderTables =
            let (JpgHuffmanTableSpec
    _, HuffmanPackedTree
    dcLuma) = DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    0 HuffmanTable
    defaultDcLumaHuffmanTable
                (JpgHuffmanTableSpec
    _, HuffmanPackedTree
    dcChroma) = DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    1 HuffmanTable
    defaultDcChromaHuffmanTable
            in
            [HuffmanPackedTree] -> Vector HuffmanPackedTree
    forall a. [a] -> Vector a
    V.fromList [ HuffmanPackedTree
    dcLuma, HuffmanPackedTree
    dcChroma, HuffmanPackedTree
    dcLuma, HuffmanPackedTree
    dcChroma ]

        , acDecoderTables :: Vector HuffmanPackedTree
    acDecoderTables =
            let (JpgHuffmanTableSpec
    _, HuffmanPackedTree
    acLuma) = DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    0 HuffmanTable
    defaultAcLumaHuffmanTable
                (JpgHuffmanTableSpec
    _, HuffmanPackedTree
    acChroma) = DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    1 HuffmanTable
    defaultAcChromaHuffmanTable
            in
            [HuffmanPackedTree] -> Vector HuffmanPackedTree
    forall a. [a] -> Vector a
    V.fromList [HuffmanPackedTree
    acLuma, HuffmanPackedTree
    acChroma, HuffmanPackedTree
    acLuma, HuffmanPackedTree
    acChroma]

        , quantizationMatrices :: Vector (MacroBlock Int16)
    quantizationMatrices = Int -> MacroBlock Int16 -> Vector (MacroBlock Int16)
    forall a. Int -> a -> Vector a
    V.replicate Int
    4 (Int -> Int16 -> MacroBlock Int16
    forall a. Storable a => Int -> a -> Vector a
    VS.replicate (Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8) Int16
    1)
        , currentRestartInterv :: Int
    currentRestartInterv = -Int
    1
        , currentFrame :: Maybe JpgFrameHeader
    currentFrame         = Maybe JpgFrameHeader
    forall a. Maybe a
    Nothing
        , componentIndexMapping :: [(Word8, Int)]
    componentIndexMapping = []
        , app14Marker :: Maybe JpgAdobeApp14
    app14Marker = Maybe JpgAdobeApp14
    forall a. Maybe a
    Nothing
        , app0JFifMarker :: Maybe JpgJFIFApp0
    app0JFifMarker = Maybe JpgJFIFApp0
    forall a. Maybe a
    Nothing
        , app1ExifMarker :: Maybe [ImageFileDirectory]
    app1ExifMarker = Maybe [ImageFileDirectory]
    forall a. Maybe a
    Nothing
        , isProgressive :: Bool
    isProgressive        = Bool
    False
        , maximumHorizontalResolution :: Int
    maximumHorizontalResolution = Int
    0
        , maximumVerticalResolution :: Int
    maximumVerticalResolution   = Int
    0
        , seenBlobs :: Int
    seenBlobs = Int
    0
        }

    -- | This pseudo interpreter interpret the Jpg frame for the huffman,

    -- quant table and restart interval parameters.

    jpgMachineStep :: JpgFrame -> JpgScripter s ()
    jpgMachineStep :: forall s. JpgFrame -> JpgScripter s ()
    jpgMachineStep (JpgAdobeAPP14 JpgAdobeApp14
    app14) = (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
        JpgDecoderState
    s { app14Marker = Just app14 }
    jpgMachineStep (JpgExif [ImageFileDirectory]
    exif) = (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
        JpgDecoderState
    s { app1ExifMarker = Just exif }
    jpgMachineStep (JpgJFIF JpgJFIFApp0
    app0) = (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
        JpgDecoderState
    s { app0JFifMarker = Just app0 }
    jpgMachineStep (JpgAppFrame Word8
    _ ByteString
    _) = ()
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a.
    a
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    jpgMachineStep (JpgExtension Word8
    _ ByteString
    _) = ()
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a.
    a
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    jpgMachineStep (JpgScanBlob JpgScanHeader
    hdr ByteString
    raw_data) = do
        let scanCount :: Int
    scanCount = [JpgScanSpecification] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([JpgScanSpecification] -> Int) -> [JpgScanSpecification] -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> [JpgScanSpecification]
    scans JpgScanHeader
    hdr
        [(JpgUnpackerParameter, Unpacker s)]
    params <- [[(JpgUnpackerParameter, Unpacker s)]]
    -> [(JpgUnpackerParameter, Unpacker s)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(JpgUnpackerParameter, Unpacker s)]]
     -> [(JpgUnpackerParameter, Unpacker s)])
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [[(JpgUnpackerParameter, Unpacker s)]]
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [(JpgUnpackerParameter, Unpacker s)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (JpgScanSpecification
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          [(JpgUnpackerParameter, Unpacker s)])
    -> [JpgScanSpecification]
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [[(JpgUnpackerParameter, Unpacker s)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Int
    -> JpgScanSpecification
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [(JpgUnpackerParameter, Unpacker s)]
    scanSpecifier Int
    scanCount) (JpgScanHeader -> [JpgScanSpecification]
    scans JpgScanHeader
    hdr)

        (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    st -> JpgDecoderState
    st { seenBlobs = seenBlobs st + 1 }
        [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
    tell [([(JpgUnpackerParameter, Unpacker s)]
    params, ByteString
    raw_data)  ]
      where (Word8
    selectionLow, Word8
    selectionHigh) = JpgScanHeader -> (Word8, Word8)
    spectralSelection JpgScanHeader
    hdr
            approxHigh :: Int
    approxHigh = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> Word8
    successiveApproxHigh JpgScanHeader
    hdr
            approxLow :: Int
    approxLow = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> Word8
    successiveApproxLow JpgScanHeader
    hdr

            scanSpecifier :: Int
    -> JpgScanSpecification
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [(JpgUnpackerParameter, Unpacker s)]
    scanSpecifier Int
    scanCount JpgScanSpecification
    scanSpec = do
                [(Word8, Int)]
    compMapping <- (JpgDecoderState -> [(Word8, Int)])
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [(Word8, Int)]
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> [(Word8, Int)]
    componentIndexMapping
                Int
    comp <- case Word8 -> [(Word8, Int)] -> Maybe Int
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (JpgScanSpecification -> Word8
    componentSelector JpgScanSpecification
    scanSpec) [(Word8, Int)]
    compMapping of
                    Maybe Int
    Nothing -> String
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Int
    forall a. HasCallStack => String -> a
    error String
    "Jpg decoding error - bad component selector in blob."
                    Just Int
    v -> Int
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Int
    forall a.
    a
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    v
                let maximumHuffmanTable :: Int
    maximumHuffmanTable = Int
    4
                    dcIndex :: Int
    dcIndex = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    maximumHuffmanTable Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                                (Int -> Int) -> (Word8 -> Int) -> Word8 -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgScanSpecification -> Word8
    dcEntropyCodingTable JpgScanSpecification
    scanSpec
                    acIndex :: Int
    acIndex = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    maximumHuffmanTable Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                                (Int -> Int) -> (Word8 -> Int) -> Word8 -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgScanSpecification -> Word8
    acEntropyCodingTable JpgScanSpecification
    scanSpec

                HuffmanPackedTree
    dcTree <- (JpgDecoderState -> HuffmanPackedTree)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         HuffmanPackedTree
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets ((JpgDecoderState -> HuffmanPackedTree)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          HuffmanPackedTree)
    -> (JpgDecoderState -> HuffmanPackedTree)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         HuffmanPackedTree
    forall a b. (a -> b) -> a -> b
    $ (Vector HuffmanPackedTree -> Int -> HuffmanPackedTree
    forall a. Vector a -> Int -> a
    V.! Int
    dcIndex) (Vector HuffmanPackedTree -> HuffmanPackedTree)
    -> (JpgDecoderState -> Vector HuffmanPackedTree)
    -> JpgDecoderState
    -> HuffmanPackedTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JpgDecoderState -> Vector HuffmanPackedTree
    dcDecoderTables
                HuffmanPackedTree
    acTree <- (JpgDecoderState -> HuffmanPackedTree)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         HuffmanPackedTree
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets ((JpgDecoderState -> HuffmanPackedTree)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          HuffmanPackedTree)
    -> (JpgDecoderState -> HuffmanPackedTree)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         HuffmanPackedTree
    forall a b. (a -> b) -> a -> b
    $ (Vector HuffmanPackedTree -> Int -> HuffmanPackedTree
    forall a. Vector a -> Int -> a
    V.! Int
    acIndex) (Vector HuffmanPackedTree -> HuffmanPackedTree)
    -> (JpgDecoderState -> Vector HuffmanPackedTree)
    -> JpgDecoderState
    -> HuffmanPackedTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JpgDecoderState -> Vector HuffmanPackedTree
    acDecoderTables
                Bool
    isProgressiveImage <- (JpgDecoderState -> Bool)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Bool
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> Bool
    isProgressive
                Int
    maxiW <- (JpgDecoderState -> Int)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Int
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> Int
    maximumHorizontalResolution
                Int
    maxiH <- (JpgDecoderState -> Int)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Int
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> Int
    maximumVerticalResolution
                Int
    restart <- (JpgDecoderState -> Int)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Int
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> Int
    currentRestartInterv
                Maybe JpgFrameHeader
    frameInfo <- (JpgDecoderState -> Maybe JpgFrameHeader)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         (Maybe JpgFrameHeader)
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> Maybe JpgFrameHeader
    currentFrame
                Int
    blobId <- (JpgDecoderState -> Int)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         Int
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> a) -> RWST r w s m a
    gets JpgDecoderState -> Int
    seenBlobs
                case Maybe JpgFrameHeader
    frameInfo of
                  Maybe JpgFrameHeader
    Nothing -> String
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [(JpgUnpackerParameter, Unpacker s)]
    forall a. HasCallStack => String -> a
    error String
    "Jpg decoding error - no previous frame"
                  Just JpgFrameHeader
    v -> do
                     let compDesc :: JpgComponent
    compDesc = JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    v [JpgComponent] -> Int -> JpgComponent
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    comp
                         compCount :: Int
    compCount = [JpgComponent] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([JpgComponent] -> Int) -> [JpgComponent] -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    v
                         xSampling :: Int
    xSampling = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgComponent -> Word8
    horizontalSamplingFactor JpgComponent
    compDesc
                         ySampling :: Int
    ySampling = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgComponent -> Word8
    verticalSamplingFactor JpgComponent
    compDesc
                         componentSubSampling :: (Int, Int)
    componentSubSampling =
                            (Int
    maxiW Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xSampling Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1, Int
    maxiH Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ySampling Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                         (Int
    xCount, Int
    yCount)
                            | Int
    scanCount Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 Bool -> Bool -> Bool
    || Bool
    isProgressiveImage = (Int
    xSampling, Int
    ySampling)
                            | Bool
    otherwise = (Int
    1, Int
    1)

                     [(JpgUnpackerParameter, Unpacker s)]
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         [(JpgUnpackerParameter, Unpacker s)]
    forall a.
    a
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ (JpgUnpackerParameter
                             { dcHuffmanTree :: HuffmanPackedTree
    dcHuffmanTree = HuffmanPackedTree
    dcTree
                             , acHuffmanTree :: HuffmanPackedTree
    acHuffmanTree = HuffmanPackedTree
    acTree
                             , componentIndex :: Int
    componentIndex = Int
    comp
                             , restartInterval :: Int
    restartInterval = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    restart
                             , componentWidth :: Int
    componentWidth = Int
    xSampling
                             , componentHeight :: Int
    componentHeight = Int
    ySampling
                             , subSampling :: (Int, Int)
    subSampling = (Int, Int)
    componentSubSampling
                             , successiveApprox :: (Int, Int)
    successiveApprox = (Int
    approxLow, Int
    approxHigh)
                             , readerIndex :: Int
    readerIndex = Int
    blobId
                             , indiceVector :: Int
    indiceVector =
                                 if Int
    scanCount Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 then Int
    0 else Int
    1
                             , coefficientRange :: (Int, Int)
    coefficientRange =
                                 ( Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    selectionLow
                                 , Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    selectionHigh )
                             , blockIndex :: Int
    blockIndex = Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    xSampling Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x
                             , blockMcuX :: Int
    blockMcuX = Int
    x
                             , blockMcuY :: Int
    blockMcuY = Int
    y
                             }, Int -> (Int, Int) -> Unpacker s
    forall s. Int -> (Int, Int) -> Unpacker s
    unpackerDecision Int
    compCount (Int, Int)
    componentSubSampling)
                                 | Int
    y <- [Int
    0 .. Int
    yCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                                 , Int
    x <- [Int
    0 .. Int
    xCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ]

    jpgMachineStep (JpgScans JpgFrameKind
    kind JpgFrameHeader
    hdr) = (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
       JpgDecoderState
    s { currentFrame = Just hdr
         , componentIndexMapping =
              [(componentIdentifier comp, ix) | (ix, comp) <- zip [0..] $ jpgComponents hdr]
         , isProgressive = case kind of
                JpgFrameKind
    JpgProgressiveDCTHuffman -> Bool
    True
                JpgFrameKind
    _ -> Bool
    False
         , maximumHorizontalResolution =
             fromIntegral $ maximum horizontalResolutions
         , maximumVerticalResolution =
             fromIntegral $ maximum verticalResolutions
         }
        where components :: [JpgComponent]
    components = JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    hdr
              horizontalResolutions :: [Word8]
    horizontalResolutions = (JpgComponent -> Word8) -> [JpgComponent] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map JpgComponent -> Word8
    horizontalSamplingFactor [JpgComponent]
    components
              verticalResolutions :: [Word8]
    verticalResolutions = (JpgComponent -> Word8) -> [JpgComponent] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map JpgComponent -> Word8
    verticalSamplingFactor [JpgComponent]
    components
    jpgMachineStep (JpgIntervalRestart Word16
    restart) =
        (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s -> JpgDecoderState
    s { currentRestartInterv = fromIntegral restart }
    jpgMachineStep (JpgHuffmanTable [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    tables) = ((JpgHuffmanTableSpec, HuffmanPackedTree)
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (JpgHuffmanTableSpec, HuffmanPackedTree)
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall {w} {m :: * -> *} {r}.
    (Monoid w, Monad m) =>
    (JpgHuffmanTableSpec, HuffmanPackedTree)
    -> RWST r w JpgDecoderState m ()
    placeHuffmanTrees [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    tables
      where placeHuffmanTrees :: (JpgHuffmanTableSpec, HuffmanPackedTree)
    -> RWST r w JpgDecoderState m ()
    placeHuffmanTrees (JpgHuffmanTableSpec
    spec, HuffmanPackedTree
    tree) = case JpgHuffmanTableSpec -> DctComponent
    huffmanTableClass JpgHuffmanTableSpec
    spec of
                DctComponent
    DcComponent -> (JpgDecoderState -> JpgDecoderState)
    -> RWST r w JpgDecoderState m ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST r w JpgDecoderState m ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST r w JpgDecoderState m ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
                  if Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Vector HuffmanPackedTree -> Int
    forall a. Vector a -> Int
    V.length (JpgDecoderState -> Vector HuffmanPackedTree
    dcDecoderTables JpgDecoderState
    s) then JpgDecoderState
    s
                  else
                    let neu :: Vector HuffmanPackedTree
    neu = JpgDecoderState -> Vector HuffmanPackedTree
    dcDecoderTables JpgDecoderState
    s Vector HuffmanPackedTree
    -> [(Int, HuffmanPackedTree)] -> Vector HuffmanPackedTree
    forall a. Vector a -> [(Int, a)] -> Vector a
    // [(Int
    idx, HuffmanPackedTree
    tree)] in
                    JpgDecoderState
    s { dcDecoderTables = neu }
                        where idx :: Int
    idx = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Word8
    huffmanTableDest JpgHuffmanTableSpec
    spec

                DctComponent
    AcComponent -> (JpgDecoderState -> JpgDecoderState)
    -> RWST r w JpgDecoderState m ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST r w JpgDecoderState m ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST r w JpgDecoderState m ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
                  if Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Vector HuffmanPackedTree -> Int
    forall a. Vector a -> Int
    V.length (JpgDecoderState -> Vector HuffmanPackedTree
    acDecoderTables JpgDecoderState
    s) then JpgDecoderState
    s
                  else
                    JpgDecoderState
    s { acDecoderTables = acDecoderTables s // [(idx, tree)] }
                        where idx :: Int
    idx = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Word8
    huffmanTableDest JpgHuffmanTableSpec
    spec

    jpgMachineStep (JpgQuantTable [JpgQuantTableSpec]
    tables) = (JpgQuantTableSpec
     -> RWST
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          Identity
          ())
    -> [JpgQuantTableSpec]
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ JpgQuantTableSpec
    -> RWST
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         Identity
         ()
    forall {w} {m :: * -> *} {r}.
    (Monoid w, Monad m) =>
    JpgQuantTableSpec -> RWST r w JpgDecoderState m ()
    placeQuantizationTables [JpgQuantTableSpec]
    tables
      where placeQuantizationTables :: JpgQuantTableSpec -> RWST r w JpgDecoderState m ()
    placeQuantizationTables JpgQuantTableSpec
    table = do
                let idx :: Int
    idx = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgQuantTableSpec -> Word8
    quantDestination JpgQuantTableSpec
    table
                    tableData :: MacroBlock Int16
    tableData = JpgQuantTableSpec -> MacroBlock Int16
    quantTable JpgQuantTableSpec
    table
                (JpgDecoderState -> JpgDecoderState)
    -> RWST r w JpgDecoderState m ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    (s -> s) -> RWST r w s m ()
    modify ((JpgDecoderState -> JpgDecoderState)
     -> RWST r w JpgDecoderState m ())
    -> (JpgDecoderState -> JpgDecoderState)
    -> RWST r w JpgDecoderState m ()
    forall a b. (a -> b) -> a -> b
    $ \JpgDecoderState
    s ->
                    JpgDecoderState
    s { quantizationMatrices =  quantizationMatrices s // [(idx, tableData)] }

    unpackerDecision :: Int -> (Int, Int) -> Unpacker s
    unpackerDecision :: forall s. Int -> (Int, Int) -> Unpacker s
    unpackerDecision Int
    1 (Int
    1, Int
    1) = Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    forall s.
    Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpack444Y
    unpackerDecision Int
    3 (Int
    1, Int
    1) = Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    forall s.
    Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpack444Ycbcr
    unpackerDecision Int
    _ (Int
    2, Int
    1) = Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    forall s.
    Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpack421Ycbcr
    unpackerDecision Int
    compCount (Int
    xScalingFactor, Int
    yScalingFactor) =
        Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    forall s.
    Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpackMacroBlock Int
    compCount Int
    xScalingFactor Int
    yScalingFactor

    decodeImage :: JpgFrameHeader
                -> V.Vector (MacroBlock Int16)
                -> [([(JpgUnpackerParameter, Unpacker s)], L.ByteString)]
                -> MutableImage s PixelYCbCr8 -- ^ Result image to write into

                -> ST s (MutableImage s PixelYCbCr8)
    decodeImage :: forall s.
    JpgFrameHeader
    -> Vector (MacroBlock Int16)
    -> [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    -> MutableImage s PixelYCbCr8
    -> ST s (MutableImage s PixelYCbCr8)
    decodeImage JpgFrameHeader
    frame Vector (MacroBlock Int16)
    quants [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    lst MutableImage s PixelYCbCr8
    outImage = do
      let compCount :: Int
    compCount = [JpgComponent] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([JpgComponent] -> Int) -> [JpgComponent] -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    frame
      MutableMacroBlock s Int16
    zigZagArray <- ST s (MutableMacroBlock s Int16)
    forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock
      MutableMacroBlock s Int16
    dcArray <- Int -> Int16 -> ST s (MVector (PrimState (ST s)) Int16)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> a -> m (MVector (PrimState m) a)
    M.replicate Int
    compCount Int16
    0  :: ST s (M.STVector s DcCoefficient)
      STRef s Int
    resetCounter <- Int -> ST s (STRef s Int)
    forall a s. a -> ST s (STRef s a)
    newSTRef Int
    restartIntervalValue

      [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    -> (([(JpgUnpackerParameter, Unpacker s)], ByteString)
        -> ST s BoolState)
    -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    lst ((([(JpgUnpackerParameter, Unpacker s)], ByteString)
      -> ST s BoolState)
     -> ST s ())
    -> (([(JpgUnpackerParameter, Unpacker s)], ByteString)
        -> ST s BoolState)
    -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \([(JpgUnpackerParameter, Unpacker s)]
    params, ByteString
    str) -> do
        let componentsInfo :: Vector (JpgUnpackerParameter, Unpacker s)
    componentsInfo = [(JpgUnpackerParameter, Unpacker s)]
    -> Vector (JpgUnpackerParameter, Unpacker s)
    forall a. [a] -> Vector a
    V.fromList [(JpgUnpackerParameter, Unpacker s)]
    params
            compReader :: BoolState
    compReader = ByteString -> BoolState
    initBoolStateJpg (ByteString -> BoolState)
    -> ([ByteString] -> ByteString) -> [ByteString] -> BoolState
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    B.concat ([ByteString] -> BoolState) -> [ByteString] -> BoolState
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    L.toChunks ByteString
    str
            maxiSubSampW :: Int
    maxiSubSampW = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [(Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgUnpackerParameter -> (Int, Int)
    subSampling JpgUnpackerParameter
    c | (JpgUnpackerParameter
    c,Unpacker s
    _) <- [(JpgUnpackerParameter, Unpacker s)]
    params]
            maxiSubSampH :: Int
    maxiSubSampH = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [(Int, Int) -> Int
    forall a b. (a, b) -> b
    snd ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgUnpackerParameter -> (Int, Int)
    subSampling JpgUnpackerParameter
    c | (JpgUnpackerParameter
    c,Unpacker s
    _) <- [(JpgUnpackerParameter, Unpacker s)]
    params]

            (Int
    maxiW, Int
    maxiH) =
                if [(JpgUnpackerParameter, Unpacker s)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(JpgUnpackerParameter, Unpacker s)]
    params Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 then
                    ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [JpgUnpackerParameter -> Int
    componentWidth JpgUnpackerParameter
    c | (JpgUnpackerParameter
    c,Unpacker s
    _) <- [(JpgUnpackerParameter, Unpacker s)]
    params],
                        [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [JpgUnpackerParameter -> Int
    componentHeight JpgUnpackerParameter
    c | (JpgUnpackerParameter
    c,Unpacker s
    _) <- [(JpgUnpackerParameter, Unpacker s)]
    params])
                else
                    (Int
    maxiSubSampW, Int
    maxiSubSampH)

            imageBlockWidth :: Int
    imageBlockWidth = Int -> Int
    toBlockSize Int
    imgWidth
            imageBlockHeight :: Int
    imageBlockHeight = Int -> Int
    toBlockSize Int
    imgHeight

            imageMcuWidth :: Int
    imageMcuWidth = (Int
    imageBlockWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    maxiW Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    maxiW
            imageMcuHeight :: Int
    imageMcuHeight = (Int
    imageBlockHeight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    maxiH Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    maxiH

        BoolState -> BoolReader s () -> ST s BoolState
    forall s a. BoolState -> BoolReader s a -> ST s BoolState
    execBoolReader BoolState
    compReader (BoolReader s () -> ST s BoolState)
    -> BoolReader s () -> ST s BoolState
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> (Int -> Int -> BoolReader s ()) -> BoolReader s ()
    forall (m :: * -> *).
    Monad m =>
    Int -> Int -> (Int -> Int -> m ()) -> m ()
    rasterMap Int
    imageMcuWidth Int
    imageMcuHeight ((Int -> Int -> BoolReader s ()) -> BoolReader s ())
    -> (Int -> Int -> BoolReader s ()) -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    x Int
    y -> do
          Int
    resetLeft <- ST s Int -> StateT BoolState (ST s) Int
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s Int -> StateT BoolState (ST s) Int)
    -> ST s Int -> StateT BoolState (ST s) Int
    forall a b. (a -> b) -> a -> b
    $ STRef s Int -> ST s Int
    forall s a. STRef s a -> ST s a
    readSTRef STRef s Int
    resetCounter
          if Int
    resetLeft Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then do
            ST s () -> BoolReader s ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ MVector (PrimState (ST s)) Int16 -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> a -> m ()
    M.set MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    dcArray Int16
    0
            BoolReader s ()
    forall s. BoolReader s ()
    byteAlignJpg
            Int32
    _restartCode <- BoolReader s Int32
    forall s. BoolReader s Int32
    decodeRestartInterval
            ST s () -> BoolReader s ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ STRef s Int
    resetCounter STRef s Int -> Int -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    `writeSTRef` (Int
    restartIntervalValue Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
          else
            ST s () -> BoolReader s ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ STRef s Int
    resetCounter STRef s Int -> Int -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    `writeSTRef` (Int
    resetLeft Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

          Vector (JpgUnpackerParameter, Unpacker s)
    -> ((JpgUnpackerParameter, Unpacker s) -> BoolReader s ())
    -> BoolReader s ()
    forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
    V.forM_ Vector (JpgUnpackerParameter, Unpacker s)
    componentsInfo (((JpgUnpackerParameter, Unpacker s) -> BoolReader s ())
     -> BoolReader s ())
    -> ((JpgUnpackerParameter, Unpacker s) -> BoolReader s ())
    -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ \(JpgUnpackerParameter
    comp, Unpacker s
    unpack) -> do
            let compIdx :: Int
    compIdx = JpgUnpackerParameter -> Int
    componentIndex JpgUnpackerParameter
    comp
                dcTree :: HuffmanPackedTree
    dcTree = JpgUnpackerParameter -> HuffmanPackedTree
    dcHuffmanTree JpgUnpackerParameter
    comp
                acTree :: HuffmanPackedTree
    acTree = JpgUnpackerParameter -> HuffmanPackedTree
    acHuffmanTree JpgUnpackerParameter
    comp
                quantId :: Int
    quantId = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> (JpgComponent -> Word8) -> JpgComponent -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  JpgComponent -> Word8
    quantizationTableDest
                        (JpgComponent -> Int) -> JpgComponent -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    frame [JpgComponent] -> Int -> JpgComponent
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    compIdx
                qTable :: MacroBlock Int16
    qTable = Vector (MacroBlock Int16)
    quants Vector (MacroBlock Int16) -> Int -> MacroBlock Int16
    forall a. Vector a -> Int -> a
    V.! Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    3 Int
    quantId
                xd :: Int
    xd = JpgUnpackerParameter -> Int
    blockMcuX JpgUnpackerParameter
    comp
                yd :: Int
    yd = JpgUnpackerParameter -> Int
    blockMcuY JpgUnpackerParameter
    comp
                (Int
    subX, Int
    subY) = JpgUnpackerParameter -> (Int, Int)
    subSampling JpgUnpackerParameter
    comp
            Int16
    dc <- ST s Int16 -> StateT BoolState (ST s) Int16
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s Int16 -> StateT BoolState (ST s) Int16)
    -> ST s Int16 -> StateT BoolState (ST s) Int16
    forall a b. (a -> b) -> a -> b
    $ MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    dcArray MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    compIdx
            (Int16
    dcCoeff, MutableMacroBlock s Int16
    block) <-
                  HuffmanPackedTree
    -> HuffmanPackedTree
    -> MacroBlock Int16
    -> MutableMacroBlock s Int16
    -> Int16
    -> BoolReader s (Int16, MutableMacroBlock s Int16)
    forall s.
    HuffmanPackedTree
    -> HuffmanPackedTree
    -> MacroBlock Int16
    -> MutableMacroBlock s Int16
    -> Int16
    -> BoolReader s (Int16, MutableMacroBlock s Int16)
    decompressMacroBlock HuffmanPackedTree
    dcTree HuffmanPackedTree
    acTree MacroBlock Int16
    qTable MutableMacroBlock s Int16
    zigZagArray (Int16 -> BoolReader s (Int16, MutableMacroBlock s Int16))
    -> Int16 -> BoolReader s (Int16, MutableMacroBlock s Int16)
    forall a b. (a -> b) -> a -> b
    $ Int16 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int16
    dc
            ST s () -> BoolReader s ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ (MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    dcArray MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    compIdx) Int16
    dcCoeff
            let verticalLimited :: Bool
    verticalLimited = Int
    y Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    imageMcuHeight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            if (Int
    x Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    imageMcuWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Bool -> Bool -> Bool
    || Bool
    verticalLimited then
              ST s () -> BoolReader s ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int -> Unpacker s
    forall s.
    Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> MutableImage s PixelYCbCr8
    -> MutableMacroBlock s Int16
    -> ST s ()
    unpackMacroBlock Int
    imgComponentCount
                                      Int
    subX Int
    subY Int
    compIdx
                                      (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxiW Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xd) (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxiH Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    yd) MutableImage s PixelYCbCr8
    outImage MutableMacroBlock s Int16
    block
            else
              ST s () -> BoolReader s ()
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
    forall a b. (a -> b) -> a -> b
    $ Unpacker s
    unpack Int
    compIdx (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxiW Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xd) (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxiH Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    yd) MutableImage s PixelYCbCr8
    outImage MutableMacroBlock s Int16
    block

      MutableImage s PixelYCbCr8 -> ST s (MutableImage s PixelYCbCr8)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MutableImage s PixelYCbCr8
    outImage

      where imgComponentCount :: Int
    imgComponentCount = [JpgComponent] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([JpgComponent] -> Int) -> [JpgComponent] -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    frame

            imgWidth :: Int
    imgWidth = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgWidth JpgFrameHeader
    frame
            imgHeight :: Int
    imgHeight = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgHeight JpgFrameHeader
    frame
            restartIntervalValue :: Int
    restartIntervalValue = case [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    lst of
                    ((JpgUnpackerParameter
    p,Unpacker s
    _):[(JpgUnpackerParameter, Unpacker s)]
    _,ByteString
    _): [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    _ -> JpgUnpackerParameter -> Int
    restartInterval JpgUnpackerParameter
    p
                    [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    _ -> -Int
    1

    gatherImageKind :: [JpgFrame] -> Maybe JpgImageKind
    gatherImageKind :: [JpgFrame] -> Maybe JpgImageKind
    gatherImageKind [JpgFrame]
    lst = case [JpgFrameKind
    k | JpgScans JpgFrameKind
    k JpgFrameHeader
    _ <- [JpgFrame]
    lst, JpgFrameKind -> Bool
    isDctSpecifier JpgFrameKind
    k] of
        [JpgFrameKind
    JpgBaselineDCTHuffman] -> JpgImageKind -> Maybe JpgImageKind
    forall a. a -> Maybe a
    Just JpgImageKind
    BaseLineDCT
        [JpgFrameKind
    JpgProgressiveDCTHuffman] -> JpgImageKind -> Maybe JpgImageKind
    forall a. a -> Maybe a
    Just JpgImageKind
    ProgressiveDCT
        [JpgFrameKind
    JpgExtendedSequentialDCTHuffman] -> JpgImageKind -> Maybe JpgImageKind
    forall a. a -> Maybe a
    Just JpgImageKind
    BaseLineDCT
        [JpgFrameKind]
    _ -> Maybe JpgImageKind
    forall a. Maybe a
    Nothing
      where isDctSpecifier :: JpgFrameKind -> Bool
    isDctSpecifier JpgFrameKind
    JpgProgressiveDCTHuffman = Bool
    True
            isDctSpecifier JpgFrameKind
    JpgBaselineDCTHuffman = Bool
    True
            isDctSpecifier JpgFrameKind
    JpgExtendedSequentialDCTHuffman = Bool
    True
            isDctSpecifier JpgFrameKind
    _ = Bool
    False

    gatherScanInfo :: JpgImage -> (JpgFrameKind, JpgFrameHeader)
    gatherScanInfo :: JpgImage -> (JpgFrameKind, JpgFrameHeader)
    gatherScanInfo JpgImage
    img = [(JpgFrameKind, JpgFrameHeader)] -> (JpgFrameKind, JpgFrameHeader)
    forall a. HasCallStack => [a] -> a
    head [(JpgFrameKind
    a, JpgFrameHeader
    b) | JpgScans JpgFrameKind
    a JpgFrameHeader
    b <- JpgImage -> [JpgFrame]
    jpgFrame JpgImage
    img]

    dynamicOfColorSpace :: Maybe JpgColorSpace -> Int -> Int -> VS.Vector Word8
                        -> Either String DynamicImage
    dynamicOfColorSpace :: Maybe JpgColorSpace
    -> Int -> Int -> Vector Word8 -> Either String DynamicImage
    dynamicOfColorSpace Maybe JpgColorSpace
    Nothing Int
    _ Int
    _ Vector Word8
    _ = String -> Either String DynamicImage
    forall a b. a -> Either a b
    Left String
    "Unknown color space"
    dynamicOfColorSpace (Just JpgColorSpace
    color) Int
    w Int
    h Vector Word8
    imgData = case JpgColorSpace
    color of
      JpgColorSpace
    JpgColorSpaceCMYK -> DynamicImage -> Either String DynamicImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynamicImage -> Either String DynamicImage)
    -> (Image PixelCMYK8 -> DynamicImage)
    -> Image PixelCMYK8
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelCMYK8 -> DynamicImage
    ImageCMYK8 (Image PixelCMYK8 -> Either String DynamicImage)
    -> Image PixelCMYK8 -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int
    -> Vector (PixelBaseComponent PixelCMYK8)
    -> Image PixelCMYK8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Word8
    Vector (PixelBaseComponent PixelCMYK8)
    imgData
      JpgColorSpace
    JpgColorSpaceYCCK ->
         let ymg :: Image PixelYCbCrK8
    ymg = Int
    -> Int
    -> Vector (PixelBaseComponent PixelYCbCrK8)
    -> Image PixelYCbCrK8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h (Vector (PixelBaseComponent PixelYCbCrK8) -> Image PixelYCbCrK8)
    -> Vector (PixelBaseComponent PixelYCbCrK8) -> Image PixelYCbCrK8
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Word8) -> Vector Word8 -> Vector Word8
    forall a b.
    (Storable a, Storable b) =>
    (a -> b) -> Vector a -> Vector b
    VS.map (Word8
    255Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    -) Vector Word8
    imgData :: Image PixelYCbCrK8 in
         DynamicImage -> Either String DynamicImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynamicImage -> Either String DynamicImage)
    -> (Image PixelCMYK8 -> DynamicImage)
    -> Image PixelCMYK8
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelCMYK8 -> DynamicImage
    ImageCMYK8 (Image PixelCMYK8 -> Either String DynamicImage)
    -> Image PixelCMYK8 -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Image PixelYCbCrK8 -> Image PixelCMYK8
    forall a b. ColorSpaceConvertible a b => Image a -> Image b
    convertImage Image PixelYCbCrK8
    ymg
      JpgColorSpace
    JpgColorSpaceYCbCr -> DynamicImage -> Either String DynamicImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynamicImage -> Either String DynamicImage)
    -> (Image PixelYCbCr8 -> DynamicImage)
    -> Image PixelYCbCr8
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelYCbCr8 -> DynamicImage
    ImageYCbCr8 (Image PixelYCbCr8 -> Either String DynamicImage)
    -> Image PixelYCbCr8 -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int
    -> Vector (PixelBaseComponent PixelYCbCr8)
    -> Image PixelYCbCr8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Word8
    Vector (PixelBaseComponent PixelYCbCr8)
    imgData
      JpgColorSpace
    JpgColorSpaceRGB -> DynamicImage -> Either String DynamicImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynamicImage -> Either String DynamicImage)
    -> (Image PixelRGB8 -> DynamicImage)
    -> Image PixelRGB8
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGB8 -> DynamicImage
    ImageRGB8 (Image PixelRGB8 -> Either String DynamicImage)
    -> Image PixelRGB8 -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int -> Vector (PixelBaseComponent PixelRGB8) -> Image PixelRGB8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Word8
    Vector (PixelBaseComponent PixelRGB8)
    imgData
      JpgColorSpace
    JpgColorSpaceYA -> DynamicImage -> Either String DynamicImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynamicImage -> Either String DynamicImage)
    -> (Image PixelYA8 -> DynamicImage)
    -> Image PixelYA8
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelYA8 -> DynamicImage
    ImageYA8 (Image PixelYA8 -> Either String DynamicImage)
    -> Image PixelYA8 -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int -> Vector (PixelBaseComponent PixelYA8) -> Image PixelYA8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Word8
    Vector (PixelBaseComponent PixelYA8)
    imgData
      JpgColorSpace
    JpgColorSpaceY -> DynamicImage -> Either String DynamicImage
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynamicImage -> Either String DynamicImage)
    -> (Image Word8 -> DynamicImage)
    -> Image Word8
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image Word8 -> DynamicImage
    ImageY8 (Image Word8 -> Either String DynamicImage)
    -> Image Word8 -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector (PixelBaseComponent Word8) -> Image Word8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    w Int
    h Vector Word8
    Vector (PixelBaseComponent Word8)
    imgData
      JpgColorSpace
    colorSpace -> String -> Either String DynamicImage
    forall a b. a -> Either a b
    Left (String -> Either String DynamicImage)
    -> String -> Either String DynamicImage
    forall a b. (a -> b) -> a -> b
    $ String
    "Wrong color space : " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ JpgColorSpace -> String
    forall a. Show a => a -> String
    show JpgColorSpace
    colorSpace

    colorSpaceOfAdobe :: Int -> JpgAdobeApp14 -> Maybe JpgColorSpace
    colorSpaceOfAdobe :: Int -> JpgAdobeApp14 -> Maybe JpgColorSpace
    colorSpaceOfAdobe Int
    compCount JpgAdobeApp14
    app = case (Int
    compCount, JpgAdobeApp14 -> AdobeTransform
    _adobeTransform JpgAdobeApp14
    app) of
      (Int
    3, AdobeTransform
    AdobeYCbCr) -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JpgColorSpace
    JpgColorSpaceYCbCr
      (Int
    1, AdobeTransform
    AdobeUnknown) -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JpgColorSpace
    JpgColorSpaceY
      (Int
    3, AdobeTransform
    AdobeUnknown) -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JpgColorSpace
    JpgColorSpaceRGB
      (Int
    4, AdobeTransform
    AdobeYCck) -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JpgColorSpace
    JpgColorSpaceYCCK
      {-(4, AdobeUnknown) -> pure JpgColorSpaceCMYKInverted-}
      (Int, AdobeTransform)
    _ -> Maybe JpgColorSpace
    forall a. Maybe a
    Nothing

    colorSpaceOfState :: JpgDecoderState -> Maybe JpgColorSpace
    colorSpaceOfState :: JpgDecoderState -> Maybe JpgColorSpace
    colorSpaceOfState JpgDecoderState
    st = do
      JpgFrameHeader
    hdr <- JpgDecoderState -> Maybe JpgFrameHeader
    currentFrame JpgDecoderState
    st
      let compStr :: String
    compStr = [Int -> Char
    forall a. Enum a => Int -> a
    toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum (Word8 -> Char) -> Word8 -> Char
    forall a b. (a -> b) -> a -> b
    $ JpgComponent -> Word8
    componentIdentifier JpgComponent
    comp
                            | JpgComponent
    comp <- JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    hdr]
          app14 :: Maybe JpgColorSpace
    app14 = do
            JpgAdobeApp14
    marker <- JpgDecoderState -> Maybe JpgAdobeApp14
    app14Marker JpgDecoderState
    st
            Int -> JpgAdobeApp14 -> Maybe JpgColorSpace
    colorSpaceOfAdobe (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    compStr) JpgAdobeApp14
    marker
      Maybe JpgColorSpace
    app14 Maybe JpgColorSpace -> Maybe JpgColorSpace -> Maybe JpgColorSpace
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> Maybe JpgColorSpace
    colorSpaceOfComponentStr String
    compStr

    colorSpaceOfComponentStr :: String -> Maybe JpgColorSpace
    colorSpaceOfComponentStr :: String -> Maybe JpgColorSpace
    colorSpaceOfComponentStr String
    s = case String
    s of
      [Char
    _] -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceY
      [Char
    _,Char
    _] -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYA
      String
    "\0\1\2" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYCbCr
      String
    "\1\2\3" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYCbCr
      String
    "RGB" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceRGB
      String
    "YCc" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYCC
      [Char
    _,Char
    _,Char
    _] -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYCbCr

      String
    "RGBA" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceRGBA
      String
    "YCcA" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYCCA
      String
    "CMYK" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceCMYK
      String
    "YCcK" -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceYCCK
      [Char
    _,Char
    _,Char
    _,Char
    _] -> JpgColorSpace -> Maybe JpgColorSpace
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure  JpgColorSpace
    JpgColorSpaceCMYK
      String
    _ -> Maybe JpgColorSpace
    forall a. Maybe a
    Nothing

    -- | Try to decompress and decode a jpeg file. The colorspace is still

    -- YCbCr if you want to perform computation on the luma part. You can convert it

    -- to RGB using 'convertImage' from the 'ColorSpaceConvertible' typeclass.

    --

    -- This function can output the following images:

    --

    --  * 'ImageY8'

    --

    --  * 'ImageYA8'

    --

    --  * 'ImageRGB8'

    --

    --  * 'ImageCMYK8'

    --

    --  * 'ImageYCbCr8'

    --

    decodeJpeg :: B.ByteString -> Either String DynamicImage
    decodeJpeg :: ByteString -> Either String DynamicImage
    decodeJpeg = ((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)
    decodeJpegWithMetadata

    -- | Equivalent to 'decodeJpeg' but also extracts metadatas.

    --

    -- Extract the following metadatas from the JFIF block:

    --

    --  * 'Codec.Picture.Metadata.DpiX'

    --  * 'Codec.Picture.Metadata.DpiY'

    --

    -- Exif metadata are also extracted if present.

    --

    decodeJpegWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
    decodeJpegWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
    decodeJpegWithMetadata ByteString
    file = case Get JpgImage -> ByteString -> Either String JpgImage
    forall a. Get a -> ByteString -> Either String a
    runGetStrict Get JpgImage
    forall t. Binary t => Get t
    get ByteString
    file of
      Left String
    err -> String -> Either String (DynamicImage, Metadatas)
    forall a b. a -> Either a b
    Left String
    err
      Right JpgImage
    img -> case Maybe JpgImageKind
    imgKind of
         Just JpgImageKind
    BaseLineDCT ->
           let (JpgDecoderState
    st, Vector Word8
    arr) = (JpgDecoderState, Vector Word8)
    decodeBaseline
               jfifMeta :: Metadatas
    jfifMeta = (JpgJFIFApp0 -> Metadatas) -> Maybe JpgJFIFApp0 -> Metadatas
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap JpgJFIFApp0 -> Metadatas
    extractMetadatas (Maybe JpgJFIFApp0 -> Metadatas) -> Maybe JpgJFIFApp0 -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ JpgDecoderState -> Maybe JpgJFIFApp0
    app0JFifMarker JpgDecoderState
    st
               exifMeta :: Metadatas
    exifMeta = ([ImageFileDirectory] -> Metadatas)
    -> Maybe [ImageFileDirectory] -> Metadatas
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap [ImageFileDirectory] -> Metadatas
    extractTiffMetadata (Maybe [ImageFileDirectory] -> Metadatas)
    -> Maybe [ImageFileDirectory] -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ JpgDecoderState -> Maybe [ImageFileDirectory]
    app1ExifMarker JpgDecoderState
    st
               meta :: Metadatas
    meta = Metadatas
    jfifMeta Metadatas -> Metadatas -> Metadatas
    forall a. Semigroup a => a -> a -> a
    <> Metadatas
    exifMeta Metadatas -> Metadatas -> Metadatas
    forall a. Semigroup a => a -> a -> a
    <> Metadatas
    sizeMeta
           in
           (, Metadatas
    meta) (DynamicImage -> (DynamicImage, Metadatas))
    -> Either String DynamicImage
    -> Either String (DynamicImage, Metadatas)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
               Maybe JpgColorSpace
    -> Int -> Int -> Vector Word8 -> Either String DynamicImage
    dynamicOfColorSpace (JpgDecoderState -> Maybe JpgColorSpace
    colorSpaceOfState JpgDecoderState
    st) Int
    imgWidth Int
    imgHeight Vector Word8
    arr
         Just JpgImageKind
    ProgressiveDCT ->
           let (JpgDecoderState
    st, Vector Word8
    arr) = (JpgDecoderState, Vector Word8)
    decodeProgressive
               jfifMeta :: Metadatas
    jfifMeta = (JpgJFIFApp0 -> Metadatas) -> Maybe JpgJFIFApp0 -> Metadatas
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap JpgJFIFApp0 -> Metadatas
    extractMetadatas (Maybe JpgJFIFApp0 -> Metadatas) -> Maybe JpgJFIFApp0 -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ JpgDecoderState -> Maybe JpgJFIFApp0
    app0JFifMarker JpgDecoderState
    st
               exifMeta :: Metadatas
    exifMeta = ([ImageFileDirectory] -> Metadatas)
    -> Maybe [ImageFileDirectory] -> Metadatas
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap [ImageFileDirectory] -> Metadatas
    extractTiffMetadata (Maybe [ImageFileDirectory] -> Metadatas)
    -> Maybe [ImageFileDirectory] -> Metadatas
    forall a b. (a -> b) -> a -> b
    $ JpgDecoderState -> Maybe [ImageFileDirectory]
    app1ExifMarker JpgDecoderState
    st
               meta :: Metadatas
    meta = Metadatas
    jfifMeta Metadatas -> Metadatas -> Metadatas
    forall a. Semigroup a => a -> a -> a
    <> Metadatas
    exifMeta Metadatas -> Metadatas -> Metadatas
    forall a. Semigroup a => a -> a -> a
    <> Metadatas
    sizeMeta
           in
           (, Metadatas
    meta) (DynamicImage -> (DynamicImage, Metadatas))
    -> Either String DynamicImage
    -> Either String (DynamicImage, Metadatas)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
               Maybe JpgColorSpace
    -> Int -> Int -> Vector Word8 -> Either String DynamicImage
    dynamicOfColorSpace (JpgDecoderState -> Maybe JpgColorSpace
    colorSpaceOfState JpgDecoderState
    st) Int
    imgWidth Int
    imgHeight Vector Word8
    arr
         Maybe JpgImageKind
    _ -> String -> Either String (DynamicImage, Metadatas)
    forall a b. a -> Either a b
    Left String
    "Unknown JPG kind"
        where
          compCount :: Int
    compCount = [JpgComponent] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([JpgComponent] -> Int) -> [JpgComponent] -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    scanInfo
          (JpgFrameKind
    _,JpgFrameHeader
    scanInfo) = JpgImage -> (JpgFrameKind, JpgFrameHeader)
    gatherScanInfo JpgImage
    img

          imgKind :: Maybe JpgImageKind
    imgKind = [JpgFrame] -> Maybe JpgImageKind
    gatherImageKind ([JpgFrame] -> Maybe JpgImageKind)
    -> [JpgFrame] -> Maybe JpgImageKind
    forall a b. (a -> b) -> a -> b
    $ JpgImage -> [JpgFrame]
    jpgFrame JpgImage
    img
          imgWidth :: Int
    imgWidth = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgWidth JpgFrameHeader
    scanInfo
          imgHeight :: Int
    imgHeight = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgHeight JpgFrameHeader
    scanInfo

          sizeMeta :: Metadatas
    sizeMeta = SourceFormat -> Int -> Int -> Metadatas
    forall nSize.
    Integral nSize =>
    SourceFormat -> nSize -> nSize -> Metadatas
    basicMetadata SourceFormat
    SourceJpeg Int
    imgWidth Int
    imgHeight

          imageSize :: Int
    imageSize = Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgHeight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    compCount

          decodeProgressive :: (JpgDecoderState, Vector Word8)
    decodeProgressive = (forall s. ST s (JpgDecoderState, Vector Word8))
    -> (JpgDecoderState, Vector Word8)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (JpgDecoderState, Vector Word8))
     -> (JpgDecoderState, Vector Word8))
    -> (forall s. ST s (JpgDecoderState, Vector Word8))
    -> (JpgDecoderState, Vector Word8)
    forall a b. (a -> b) -> a -> b
    $ do
            let (JpgDecoderState
    st, [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
    wrotten) =
                   RWS
      ()
      [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
      JpgDecoderState
      ()
    -> ()
    -> JpgDecoderState
    -> (JpgDecoderState,
        [([(JpgUnpackerParameter, Unpacker Any)], ByteString)])
    forall r w s a. RWS r w s a -> r -> s -> (s, w)
    execRWS ((JpgFrame
     -> RWS
          ()
          [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
          JpgDecoderState
          ())
    -> [JpgFrame]
    -> RWS
         ()
         [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
         JpgDecoderState
         ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ JpgFrame
    -> RWS
         ()
         [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
         JpgDecoderState
         ()
    forall s. JpgFrame -> JpgScripter s ()
    jpgMachineStep (JpgImage -> [JpgFrame]
    jpgFrame JpgImage
    img)) () JpgDecoderState
    emptyDecoderState
                Just JpgFrameHeader
    fHdr = JpgDecoderState -> Maybe JpgFrameHeader
    currentFrame JpgDecoderState
    st
            MutableImage s PixelYCbCr8
    fimg <-
                (Int, Int)
    -> JpgFrameHeader
    -> Vector (MacroBlock Int16)
    -> [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
    -> ST s (MutableImage s PixelYCbCr8)
    forall a s.
    (Int, Int)
    -> JpgFrameHeader
    -> Vector (MacroBlock Int16)
    -> [([(JpgUnpackerParameter, a)], ByteString)]
    -> ST s (MutableImage s PixelYCbCr8)
    progressiveUnpack
                    (JpgDecoderState -> Int
    maximumHorizontalResolution JpgDecoderState
    st, JpgDecoderState -> Int
    maximumVerticalResolution JpgDecoderState
    st)
                    JpgFrameHeader
    fHdr
                    (JpgDecoderState -> Vector (MacroBlock Int16)
    quantizationMatrices JpgDecoderState
    st)
                    [([(JpgUnpackerParameter, Unpacker Any)], ByteString)]
    wrotten
            Image PixelYCbCr8
    frozen <- MutableImage (PrimState (ST s)) PixelYCbCr8
    -> ST s (Image PixelYCbCr8)
    forall a (m :: * -> *).
    (Storable (PixelBaseComponent a), PrimMonad m) =>
    MutableImage (PrimState m) a -> m (Image a)
    unsafeFreezeImage MutableImage s PixelYCbCr8
    MutableImage (PrimState (ST s)) PixelYCbCr8
    fimg
            (JpgDecoderState, Vector Word8)
    -> ST s (JpgDecoderState, Vector Word8)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JpgDecoderState
    st, Image PixelYCbCr8 -> Vector (PixelBaseComponent PixelYCbCr8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Image PixelYCbCr8
    frozen)

          decodeBaseline :: (JpgDecoderState, Vector Word8)
    decodeBaseline = (forall s. ST s (JpgDecoderState, Vector Word8))
    -> (JpgDecoderState, Vector Word8)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (JpgDecoderState, Vector Word8))
     -> (JpgDecoderState, Vector Word8))
    -> (forall s. ST s (JpgDecoderState, Vector Word8))
    -> (JpgDecoderState, Vector Word8)
    forall a b. (a -> b) -> a -> b
    $ do
            let (JpgDecoderState
    st, [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    wrotten) =
                  RWS
      ()
      [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
      JpgDecoderState
      ()
    -> ()
    -> JpgDecoderState
    -> (JpgDecoderState,
        [([(JpgUnpackerParameter, Unpacker s)], ByteString)])
    forall r w s a. RWS r w s a -> r -> s -> (s, w)
    execRWS ((JpgFrame
     -> RWS
          ()
          [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
          JpgDecoderState
          ())
    -> [JpgFrame]
    -> RWS
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ JpgFrame
    -> RWS
         ()
         [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
         JpgDecoderState
         ()
    forall s. JpgFrame -> JpgScripter s ()
    jpgMachineStep (JpgImage -> [JpgFrame]
    jpgFrame JpgImage
    img)) () JpgDecoderState
    emptyDecoderState
                Just JpgFrameHeader
    fHdr = JpgDecoderState -> Maybe JpgFrameHeader
    currentFrame JpgDecoderState
    st
            MVector s Word8
    resultImage <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new Int
    imageSize
            let wrapped :: MutableImage s PixelYCbCr8
    wrapped = Int
    -> Int
    -> STVector s (PixelBaseComponent PixelYCbCr8)
    -> MutableImage s PixelYCbCr8
    forall s a.
    Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
    MutableImage Int
    imgWidth Int
    imgHeight MVector s Word8
    STVector s (PixelBaseComponent PixelYCbCr8)
    resultImage
            MutableImage s PixelYCbCr8
    fImg <- JpgFrameHeader
    -> Vector (MacroBlock Int16)
    -> [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    -> MutableImage s PixelYCbCr8
    -> ST s (MutableImage s PixelYCbCr8)
    forall s.
    JpgFrameHeader
    -> Vector (MacroBlock Int16)
    -> [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    -> MutableImage s PixelYCbCr8
    -> ST s (MutableImage s PixelYCbCr8)
    decodeImage
                JpgFrameHeader
    fHdr
                (JpgDecoderState -> Vector (MacroBlock Int16)
    quantizationMatrices JpgDecoderState
    st)
                [([(JpgUnpackerParameter, Unpacker s)], ByteString)]
    wrotten
                MutableImage s PixelYCbCr8
    wrapped
            Image PixelYCbCr8
    frozen <- MutableImage (PrimState (ST s)) PixelYCbCr8
    -> ST s (Image PixelYCbCr8)
    forall a (m :: * -> *).
    (Storable (PixelBaseComponent a), PrimMonad m) =>
    MutableImage (PrimState m) a -> m (Image a)
    unsafeFreezeImage MutableImage s PixelYCbCr8
    MutableImage (PrimState (ST s)) PixelYCbCr8
    fImg
            (JpgDecoderState, Vector Word8)
    -> ST s (JpgDecoderState, Vector Word8)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JpgDecoderState
    st, Image PixelYCbCr8 -> Vector (PixelBaseComponent PixelYCbCr8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Image PixelYCbCr8
    frozen)

    extractBlock :: forall s px. (PixelBaseComponent px ~ Word8)
                 => Image px       -- ^ Source image

                 -> MutableMacroBlock s Int16      -- ^ Mutable block where to put extracted block

                 -> Int                     -- ^ Plane

                 -> Int                     -- ^ X sampling factor

                 -> Int                     -- ^ Y sampling factor

                 -> Int                     -- ^ Sample per pixel

                 -> Int                     -- ^ Block x

                 -> Int                     -- ^ Block y

                 -> ST s (MutableMacroBlock s Int16)
    extractBlock :: forall s px.
    (PixelBaseComponent px ~ Word8) =>
    Image px
    -> MutableMacroBlock s Int16
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> ST s (MutableMacroBlock s Int16)
    extractBlock (Image { imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
    imageData = Vector (PixelBaseComponent px)
    src })
                 MutableMacroBlock s Int16
    block Int
    1 Int
    1 Int
    sampCount Int
    plane Int
    bx Int
    by | (Int
    bx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    w Bool -> Bool -> Bool
    && (Int
    by Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    h = do
        let baseReadIdx :: Int
    baseReadIdx = (Int
    by Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    bx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize
        [ST s ()] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [(MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x)) Int16
    val
                            | Int
    y <- [Int
    0 .. Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                            , let blockReadIdx :: Int
    blockReadIdx = Int
    baseReadIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w
                            , Int
    x <- [Int
    0 .. Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                            , let val :: Int16
    val = Word8 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int16) -> Word8 -> Int16
    forall a b. (a -> b) -> a -> b
    $ Vector Word8
    Vector (PixelBaseComponent px)
    src Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` ((Int
    blockReadIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    plane)
                            ]
        MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MutableMacroBlock s Int16
    block
    extractBlock (Image { imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
    imageData = Vector (PixelBaseComponent px)
    src })
                 MutableMacroBlock s Int16
    block Int
    sampWidth Int
    sampHeight Int
    sampCount Int
    plane Int
    bx Int
    by = do
        let accessPixel :: Int -> Int -> Word8
    accessPixel Int
    x Int
    y | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    w Bool -> Bool -> Bool
    && Int
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    h = let idx :: Int
    idx = (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    plane in Vector Word8
    Vector (PixelBaseComponent px)
    src Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` Int
    idx
                            | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    w = Int -> Int -> Word8
    accessPixel (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int
    y
                            | Bool
    otherwise = Int -> Int -> Word8
    accessPixel Int
    x (Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

            pixelPerCoeff :: Int16
    pixelPerCoeff = Int -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int16) -> Int -> Int16
    forall a b. (a -> b) -> a -> b
    $ Int
    sampWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampHeight

            blockVal :: Int -> Int -> Int16
    blockVal Int
    x Int
    y = [Int16] -> Int16
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Word8 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int16) -> Word8 -> Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Word8
    accessPixel (Int
    xBase Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    dx) (Int
    yBase Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    dy)
                                    | Int
    dy <- [Int
    0 .. Int
    sampHeight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                                    , Int
    dx <- [Int
    0 .. Int
    sampWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ] Int16 -> Int16 -> Int16
    forall a. Integral a => a -> a -> a
    `div` Int16
    pixelPerCoeff
                where xBase :: Int
    xBase = Int
    blockXBegin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampWidth
                      yBase :: Int
    yBase = Int
    blockYBegin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampHeight

            blockXBegin :: Int
    blockXBegin = Int
    bx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampWidth
            blockYBegin :: Int
    blockYBegin = Int
    by Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sampHeight

        [ST s ()] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [(MutableMacroBlock s Int16
    MVector (PrimState (ST s)) Int16
    block MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x)) (Int16 -> ST s ()) -> Int16 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int16
    blockVal Int
    x Int
    y | Int
    y <- [Int
    0 .. Int
    7], Int
    x <- [Int
    0 .. Int
    7] ]
        MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MutableMacroBlock s Int16
    block

    serializeMacroBlock :: BoolWriteStateRef s
                        -> HuffmanWriterCode -> HuffmanWriterCode
                        -> MutableMacroBlock s Int32
                        -> ST s ()
    serializeMacroBlock :: forall s.
    BoolWriteStateRef s
    -> HuffmanWriterCode
    -> HuffmanWriterCode
    -> MutableMacroBlock s Int32
    -> ST s ()
    serializeMacroBlock !BoolWriteStateRef s
    st !HuffmanWriterCode
    dcCode !HuffmanWriterCode
    acCode !MutableMacroBlock s Int32
    blk =
     (MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    blk MVector (PrimState (ST s)) Int32 -> Int -> ST s Int32
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    0) ST s Int32 -> (Int32 -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int32) -> (Int32 -> ST s ()) -> Int32 -> ST s ()
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Int32 -> ST s ()
    encodeDc) ST s () -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Word32, Int) -> ST s ()
    writeAcs (Word32
    0, Int
    1) ST s () -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where writeAcs :: (Word32, Int) -> ST s ()
    writeAcs acc :: (Word32, Int)
    acc@(Word32
    _, Int
    63) =
                (MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    blk MVector (PrimState (ST s)) Int32 -> Int -> ST s Int32
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    63) ST s Int32 -> (Int32 -> ST s (Word32, Int)) -> ST s (Word32, Int)
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int32)
    -> (Int32 -> ST s (Word32, Int)) -> Int32 -> ST s (Word32, Int)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (Word32, Int) -> Int32 -> ST s (Word32, Int)
    encodeAcCoefs (Word32, Int)
    acc) ST s (Word32, Int) -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            writeAcs acc :: (Word32, Int)
    acc@(Word32
    _, Int
    i ) =
                (MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    blk MVector (PrimState (ST s)) Int32 -> Int -> ST s Int32
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead`  Int
    i) ST s Int32 -> (Int32 -> ST s (Word32, Int)) -> ST s (Word32, Int)
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int32)
    -> (Int32 -> ST s (Word32, Int)) -> Int32 -> ST s (Word32, Int)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (Word32, Int) -> Int32 -> ST s (Word32, Int)
    encodeAcCoefs (Word32, Int)
    acc) ST s (Word32, Int) -> ((Word32, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Word32, Int) -> ST s ()
    writeAcs

            encodeDc :: Int32 -> ST s ()
    encodeDc Int32
    n = BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    writeBits' BoolWriteStateRef s
    st (Word16 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    code) (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    bitCount)
                            ST s () -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word32
    ssss Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    0) (BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
    encodeInt BoolWriteStateRef s
    st Word32
    ssss Int32
    n)
                where ssss :: Word32
    ssss = Int32 -> Word32
    powerOf (Int32 -> Word32) -> Int32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    n
                      (Word8
    bitCount, Word16
    code) = HuffmanWriterCode
    dcCode HuffmanWriterCode -> Int -> (Word8, Word16)
    forall a. Vector a -> Int -> a
    `V.unsafeIndex` Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    ssss

            encodeAc :: Word32 -> Int32 -> ST s ()
    encodeAc Word32
    0         Int32
    0 = BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    writeBits' BoolWriteStateRef s
    st (Word16 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    code) (Int -> ST s ()) -> Int -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    bitCount
                where (Word8
    bitCount, Word16
    code) = HuffmanWriterCode
    acCode HuffmanWriterCode -> Int -> (Word8, Word16)
    forall a. Vector a -> Int -> a
    `V.unsafeIndex` Int
    0

            encodeAc Word32
    zeroCount Int32
    n | Word32
    zeroCount Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word32
    16 =
              BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    writeBits' BoolWriteStateRef s
    st (Word16 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    code) (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    bitCount) ST s () -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>  Word32 -> Int32 -> ST s ()
    encodeAc (Word32
    zeroCount Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    16) Int32
    n
                where (Word8
    bitCount, Word16
    code) = HuffmanWriterCode
    acCode HuffmanWriterCode -> Int -> (Word8, Word16)
    forall a. Vector a -> Int -> a
    `V.unsafeIndex` Int
    0xF0
            encodeAc Word32
    zeroCount Int32
    n =
              BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int -> ST s ()
    writeBits' BoolWriteStateRef s
    st (Word16 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    code) (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    bitCount) ST s () -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
    forall s. BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
    encodeInt BoolWriteStateRef s
    st Word32
    ssss Int32
    n
                where rrrr :: Word32
    rrrr = Word32
    zeroCount Word32 -> Int -> Word32
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    4
                      ssss :: Word32
    ssss = Int32 -> Word32
    powerOf (Int32 -> Word32) -> Int32 -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    n
                      rrrrssss :: Word32
    rrrrssss = Word32
    rrrr Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .|. Word32
    ssss
                      (Word8
    bitCount, Word16
    code) = HuffmanWriterCode
    acCode HuffmanWriterCode -> Int -> (Word8, Word16)
    forall a. Vector a -> Int -> a
    `V.unsafeIndex` Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    rrrrssss

            encodeAcCoefs :: (Word32, Int) -> Int32 -> ST s (Word32, Int)
    encodeAcCoefs (            Word32
    _, Int
    63) Int32
    0 = Word32 -> Int32 -> ST s ()
    encodeAc Word32
    0 Int32
    0 ST s () -> ST s (Word32, Int) -> ST s (Word32, Int)
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Word32, Int) -> ST s (Word32, Int)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    0, Int
    64)
            encodeAcCoefs (Word32
    zeroRunLength,  Int
    i) Int32
    0 = (Word32, Int) -> ST s (Word32, Int)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    zeroRunLength Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    1, Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            encodeAcCoefs (Word32
    zeroRunLength,  Int
    i) Int32
    n =
                Word32 -> Int32 -> ST s ()
    encodeAc Word32
    zeroRunLength Int32
    n ST s () -> ST s (Word32, Int) -> ST s (Word32, Int)
    forall a b. ST s a -> ST s b -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Word32, Int) -> ST s (Word32, Int)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    0, Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

    encodeMacroBlock :: QuantificationTable
                     -> MutableMacroBlock s Int32
                     -> MutableMacroBlock s Int32
                     -> Int16
                     -> MutableMacroBlock s Int16
                     -> ST s (Int32, MutableMacroBlock s Int32)
    encodeMacroBlock :: forall s.
    MacroBlock Int16
    -> MutableMacroBlock s Int32
    -> MutableMacroBlock s Int32
    -> Int16
    -> MutableMacroBlock s Int16
    -> ST s (Int32, MutableMacroBlock s Int32)
    encodeMacroBlock MacroBlock Int16
    quantTableOfComponent MutableMacroBlock s Int32
    workData MutableMacroBlock s Int32
    finalData Int16
    prev_dc MutableMacroBlock s Int16
    block = do
     -- the inverse level shift is performed internally by the fastDCT routine

     MutableMacroBlock s Int32
    blk <- MutableMacroBlock s Int32
    -> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int32)
    forall s.
    MutableMacroBlock s Int32
    -> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int32)
    fastDctLibJpeg MutableMacroBlock s Int32
    workData MutableMacroBlock s Int16
    block
            ST s (MutableMacroBlock s Int32)
    -> (MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32))
    -> ST s (MutableMacroBlock s Int32)
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MutableMacroBlock s Int32
    -> MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32)
    forall a s.
    Storable a =>
    MutableMacroBlock s a
    -> MutableMacroBlock s a -> ST s (MutableMacroBlock s a)
    zigZagReorderForward MutableMacroBlock s Int32
    finalData
            ST s (MutableMacroBlock s Int32)
    -> (MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32))
    -> ST s (MutableMacroBlock s Int32)
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MacroBlock Int16
    -> MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32)
    forall s.
    MacroBlock Int16
    -> MutableMacroBlock s Int32 -> ST s (MutableMacroBlock s Int32)
    quantize MacroBlock Int16
    quantTableOfComponent
     Int32
    dc <- MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    blk MVector (PrimState (ST s)) Int32 -> Int -> ST s Int32
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    0
     (MutableMacroBlock s Int32
    MVector (PrimState (ST s)) Int32
    blk MVector (PrimState (ST s)) Int32 -> Int -> Int32 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    0) (Int32 -> ST s ()) -> Int32 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int32
    dc Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    - Int16 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int16
    prev_dc
     (Int32, MutableMacroBlock s Int32)
    -> ST s (Int32, MutableMacroBlock s Int32)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int32
    dc, MutableMacroBlock s Int32
    blk)

    divUpward :: (Integral a) => a -> a -> a
    divUpward :: forall a. Integral a => a -> a -> a
    divUpward a
    n a
    dividor = a
    val a -> a -> a
    forall a. Num a => a -> a -> a
    + (if a
    rest a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    0 then a
    1 else a
    0)
        where (a
    val, a
    rest) = a
    n a -> a -> (a, a)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` a
    dividor

    prepareHuffmanTable :: DctComponent -> Word8 -> HuffmanTable
                        -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable :: DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    classVal Word8
    dest HuffmanTable
    tableDef =
       (JpgHuffmanTableSpec { huffmanTableClass :: DctComponent
    huffmanTableClass = DctComponent
    classVal
                            , huffmanTableDest :: Word8
    huffmanTableDest  = Word8
    dest
                            , huffSizes :: Vector Word8
    huffSizes = Vector Word8
    sizes
                            , huffCodes :: Vector (Vector Word8)
    huffCodes = Int -> [Vector Word8] -> Vector (Vector Word8)
    forall a. Int -> [a] -> Vector a
    V.fromListN Int
    16
                                [Int -> [Word8] -> Vector Word8
    forall a. Unbox a => Int -> [a] -> Vector a
    VU.fromListN (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ Vector Word8
    sizes Vector Word8 -> Int -> Word8
    forall a. Unbox a => Vector a -> Int -> a
    ! Int
    i) [Word8]
    lst
                                                    | (Int
    i, [Word8]
    lst) <- [Int] -> HuffmanTable -> [(Int, [Word8])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] HuffmanTable
    tableDef ]
                            }, Word16 -> HuffmanPackedTree
    forall a. Storable a => a -> Vector a
    VS.singleton Word16
    0)
          where sizes :: Vector Word8
    sizes = Int -> [Word8] -> Vector Word8
    forall a. Unbox a => Int -> [a] -> Vector a
    VU.fromListN Int
    16 ([Word8] -> Vector Word8) -> [Word8] -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ ([Word8] -> Word8) -> HuffmanTable -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> ([Word8] -> Int) -> [Word8] -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) HuffmanTable
    tableDef

    -- | Encode an image in jpeg at a reasonnable quality level.

    -- If you want better quality or reduced file size, you should

    -- use `encodeJpegAtQuality`

    encodeJpeg :: Image PixelYCbCr8 -> L.ByteString
    encodeJpeg :: Image PixelYCbCr8 -> ByteString
    encodeJpeg = Word8 -> Image PixelYCbCr8 -> ByteString
    encodeJpegAtQuality Word8
    50

    defaultHuffmanTables :: [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    defaultHuffmanTables :: [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    defaultHuffmanTables =
        [ DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    0 HuffmanTable
    defaultDcLumaHuffmanTable
        , DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    0 HuffmanTable
    defaultAcLumaHuffmanTable
        , DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    1 HuffmanTable
    defaultDcChromaHuffmanTable
        , DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    1 HuffmanTable
    defaultAcChromaHuffmanTable
        ]

    lumaQuantTableAtQuality :: Int -> QuantificationTable
    lumaQuantTableAtQuality :: Int -> MacroBlock Int16
    lumaQuantTableAtQuality Int
    qual = Int -> MacroBlock Int16 -> MacroBlock Int16
    scaleQuantisationMatrix Int
    qual MacroBlock Int16
    defaultLumaQuantizationTable

    chromaQuantTableAtQuality :: Int -> QuantificationTable
    chromaQuantTableAtQuality :: Int -> MacroBlock Int16
    chromaQuantTableAtQuality Int
    qual =
      Int -> MacroBlock Int16 -> MacroBlock Int16
    scaleQuantisationMatrix Int
    qual MacroBlock Int16
    defaultChromaQuantizationTable

    zigzaggedQuantificationSpec :: Int -> [JpgQuantTableSpec]
    zigzaggedQuantificationSpec :: Int -> [JpgQuantTableSpec]
    zigzaggedQuantificationSpec Int
    qual =
      [ JpgQuantTableSpec { quantPrecision :: Word8
    quantPrecision = Word8
    0, quantDestination :: Word8
    quantDestination = Word8
    0, quantTable :: MacroBlock Int16
    quantTable = MacroBlock Int16
    luma }
      , JpgQuantTableSpec { quantPrecision :: Word8
    quantPrecision = Word8
    0, quantDestination :: Word8
    quantDestination = Word8
    1, quantTable :: MacroBlock Int16
    quantTable = MacroBlock Int16
    chroma }
      ]
      where
        luma :: MacroBlock Int16
    luma = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    lumaQuantTableAtQuality Int
    qual
        chroma :: MacroBlock Int16
    chroma = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    chromaQuantTableAtQuality Int
    qual

    -- | Function to call to encode an image to jpeg.

    -- The quality factor should be between 0 and 100 (100 being

    -- the best quality).

    encodeJpegAtQuality :: Word8                -- ^ Quality factor

                        -> Image PixelYCbCr8    -- ^ Image to encode

                        -> L.ByteString         -- ^ Encoded JPEG

    encodeJpegAtQuality :: Word8 -> Image PixelYCbCr8 -> ByteString
    encodeJpegAtQuality Word8
    quality = Word8 -> Metadatas -> Image PixelYCbCr8 -> ByteString
    encodeJpegAtQualityWithMetadata Word8
    quality Metadatas
    forall a. Monoid a => a
    mempty

    -- | Record gathering all information to encode a component

    -- from the source image. Previously was a huge tuple

    -- burried in the code

    data EncoderState = EncoderState
      { EncoderState -> Int
    _encComponentIndex :: !Int
      , EncoderState -> Int
    _encBlockWidth     :: !Int
      , EncoderState -> Int
    _encBlockHeight    :: !Int
      , EncoderState -> MacroBlock Int16
    _encQuantTable     :: !QuantificationTable
      , EncoderState -> HuffmanWriterCode
    _encDcHuffman      :: !HuffmanWriterCode
      , EncoderState -> HuffmanWriterCode
    _encAcHuffman      :: !HuffmanWriterCode
      }

    -- | Helper type class describing all JPG-encodable pixel types

    class (Pixel px, PixelBaseComponent px ~ Word8) => JpgEncodable px where
      additionalBlocks :: Image px -> [JpgFrame]
      additionalBlocks Image px
    _ = []

      componentsOfColorSpace :: Image px -> [JpgComponent]

      encodingState :: Int -> Image px -> V.Vector EncoderState

      imageHuffmanTables :: Image px -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
      imageHuffmanTables Image px
    _ = [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    defaultHuffmanTables

      scanSpecificationOfColorSpace :: Image px -> [JpgScanSpecification]

      quantTableSpec :: Image px -> Int -> [JpgQuantTableSpec]
      quantTableSpec Image px
    _ Int
    qual = Int -> [JpgQuantTableSpec] -> [JpgQuantTableSpec]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([JpgQuantTableSpec] -> [JpgQuantTableSpec])
    -> [JpgQuantTableSpec] -> [JpgQuantTableSpec]
    forall a b. (a -> b) -> a -> b
    $ Int -> [JpgQuantTableSpec]
    zigzaggedQuantificationSpec Int
    qual

      maximumSubSamplingOf :: Image px -> Int
      maximumSubSamplingOf Image px
    _ = Int
    1

    instance JpgEncodable Pixel8 where
      scanSpecificationOfColorSpace :: Image Word8 -> [JpgScanSpecification]
    scanSpecificationOfColorSpace Image Word8
    _ =
        [ JpgScanSpecification { componentSelector :: Word8
    componentSelector = Word8
    1
                               , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    0
                               , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    0
                               }
        ]

      componentsOfColorSpace :: Image Word8 -> [JpgComponent]
    componentsOfColorSpace Image Word8
    _ =
        [ JpgComponent { componentIdentifier :: Word8
    componentIdentifier      = Word8
    1
                       , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    1
                       , verticalSamplingFactor :: Word8
    verticalSamplingFactor   = Word8
    1
                       , quantizationTableDest :: Word8
    quantizationTableDest    = Word8
    0
                       }
        ]

      imageHuffmanTables :: Image Word8 -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    imageHuffmanTables Image Word8
    _ =
        [ DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    0 HuffmanTable
    defaultDcLumaHuffmanTable
        , DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    0 HuffmanTable
    defaultAcLumaHuffmanTable
        ]

      encodingState :: Int -> Image Word8 -> Vector EncoderState
    encodingState Int
    qual Image Word8
    _ = EncoderState -> Vector EncoderState
    forall a. a -> Vector a
    V.singleton EncoderState
         { _encComponentIndex :: Int
    _encComponentIndex = Int
    0
         , _encBlockWidth :: Int
    _encBlockWidth     = Int
    1
         , _encBlockHeight :: Int
    _encBlockHeight    = Int
    1
         , _encQuantTable :: MacroBlock Int16
    _encQuantTable     = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    lumaQuantTableAtQuality Int
    qual
         , _encDcHuffman :: HuffmanWriterCode
    _encDcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultDcLumaHuffmanTree
         , _encAcHuffman :: HuffmanWriterCode
    _encAcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultAcLumaHuffmanTree
         }

    instance JpgEncodable PixelYCbCr8 where
      maximumSubSamplingOf :: Image PixelYCbCr8 -> Int
    maximumSubSamplingOf Image PixelYCbCr8
    _ = Int
    2
      quantTableSpec :: Image PixelYCbCr8 -> Int -> [JpgQuantTableSpec]
    quantTableSpec Image PixelYCbCr8
    _ Int
    qual = Int -> [JpgQuantTableSpec]
    zigzaggedQuantificationSpec Int
    qual
      scanSpecificationOfColorSpace :: Image PixelYCbCr8 -> [JpgScanSpecification]
    scanSpecificationOfColorSpace Image PixelYCbCr8
    _ =
        [ JpgScanSpecification { componentSelector :: Word8
    componentSelector = Word8
    1
                               , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    0
                               , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    0
                               }
        , JpgScanSpecification { componentSelector :: Word8
    componentSelector = Word8
    2
                               , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    1
                               , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    1
                               }
        , JpgScanSpecification { componentSelector :: Word8
    componentSelector = Word8
    3
                               , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    1
                               , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    1
                               }
        ]

      componentsOfColorSpace :: Image PixelYCbCr8 -> [JpgComponent]
    componentsOfColorSpace Image PixelYCbCr8
    _ =
        [ JpgComponent { componentIdentifier :: Word8
    componentIdentifier      = Word8
    1
                       , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    2
                       , verticalSamplingFactor :: Word8
    verticalSamplingFactor   = Word8
    2
                       , quantizationTableDest :: Word8
    quantizationTableDest    = Word8
    0
                       }
        , JpgComponent { componentIdentifier :: Word8
    componentIdentifier      = Word8
    2
                       , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    1
                       , verticalSamplingFactor :: Word8
    verticalSamplingFactor   = Word8
    1
                       , quantizationTableDest :: Word8
    quantizationTableDest    = Word8
    1
                       }
        , JpgComponent { componentIdentifier :: Word8
    componentIdentifier      = Word8
    3
                       , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    1
                       , verticalSamplingFactor :: Word8
    verticalSamplingFactor   = Word8
    1
                       , quantizationTableDest :: Word8
    quantizationTableDest    = Word8
    1
                       }
        ]

      encodingState :: Int -> Image PixelYCbCr8 -> Vector EncoderState
    encodingState Int
    qual Image PixelYCbCr8
    _ = Int -> [EncoderState] -> Vector EncoderState
    forall a. Int -> [a] -> Vector a
    V.fromListN Int
    3 [EncoderState
    lumaState, EncoderState
    chromaState, EncoderState
    chromaState { _encComponentIndex = 2 }]
        where
          lumaState :: EncoderState
    lumaState = EncoderState
            { _encComponentIndex :: Int
    _encComponentIndex = Int
    0
            , _encBlockWidth :: Int
    _encBlockWidth     = Int
    2
            , _encBlockHeight :: Int
    _encBlockHeight    = Int
    2
            , _encQuantTable :: MacroBlock Int16
    _encQuantTable     = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    lumaQuantTableAtQuality Int
    qual
            , _encDcHuffman :: HuffmanWriterCode
    _encDcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultDcLumaHuffmanTree
            , _encAcHuffman :: HuffmanWriterCode
    _encAcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultAcLumaHuffmanTree
            }
          chromaState :: EncoderState
    chromaState = EncoderState
            { _encComponentIndex :: Int
    _encComponentIndex = Int
    1
            , _encBlockWidth :: Int
    _encBlockWidth     = Int
    1
            , _encBlockHeight :: Int
    _encBlockHeight    = Int
    1
            , _encQuantTable :: MacroBlock Int16
    _encQuantTable     = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    chromaQuantTableAtQuality Int
    qual
            , _encDcHuffman :: HuffmanWriterCode
    _encDcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultDcChromaHuffmanTree
            , _encAcHuffman :: HuffmanWriterCode
    _encAcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultAcChromaHuffmanTree
            }

    instance JpgEncodable PixelRGB8 where
      additionalBlocks :: Image PixelRGB8 -> [JpgFrame]
    additionalBlocks Image PixelRGB8
    _ = [JpgAdobeApp14 -> JpgFrame
    JpgAdobeAPP14 JpgAdobeApp14
    adobe14] where
        adobe14 :: JpgAdobeApp14
    adobe14 = JpgAdobeApp14
            { _adobeDctVersion :: Word16
    _adobeDctVersion = Word16
    100
            , _adobeFlag0 :: Word16
    _adobeFlag0      = Word16
    0
            , _adobeFlag1 :: Word16
    _adobeFlag1      = Word16
    0
            , _adobeTransform :: AdobeTransform
    _adobeTransform  = AdobeTransform
    AdobeUnknown
            }

      imageHuffmanTables :: Image PixelRGB8 -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    imageHuffmanTables Image PixelRGB8
    _ =
        [ DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    0 HuffmanTable
    defaultDcLumaHuffmanTable
        , DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    0 HuffmanTable
    defaultAcLumaHuffmanTable
        ]

      scanSpecificationOfColorSpace :: Image PixelRGB8 -> [JpgScanSpecification]
    scanSpecificationOfColorSpace Image PixelRGB8
    _ = (Char -> JpgScanSpecification) -> String -> [JpgScanSpecification]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Char -> JpgScanSpecification
    forall {a}. Enum a => a -> JpgScanSpecification
    build String
    "RGB" where
        build :: a -> JpgScanSpecification
    build a
    c = JpgScanSpecification
          { componentSelector :: Word8
    componentSelector = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c
          , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    0
          , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    0
          }

      componentsOfColorSpace :: Image PixelRGB8 -> [JpgComponent]
    componentsOfColorSpace Image PixelRGB8
    _ = (Char -> JpgComponent) -> String -> [JpgComponent]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Char -> JpgComponent
    forall {a}. Enum a => a -> JpgComponent
    build String
    "RGB" where
        build :: a -> JpgComponent
    build a
    c = JpgComponent
          { componentIdentifier :: Word8
    componentIdentifier      = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c
          , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    1
          , verticalSamplingFactor :: Word8
    verticalSamplingFactor   = Word8
    1
          , quantizationTableDest :: Word8
    quantizationTableDest    = Word8
    0
          }

      encodingState :: Int -> Image PixelRGB8 -> Vector EncoderState
    encodingState Int
    qual Image PixelRGB8
    _ = Int -> [EncoderState] -> Vector EncoderState
    forall a. Int -> [a] -> Vector a
    V.fromListN Int
    3 ([EncoderState] -> Vector EncoderState)
    -> [EncoderState] -> Vector EncoderState
    forall a b. (a -> b) -> a -> b
    $ (Int -> EncoderState) -> [Int] -> [EncoderState]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> EncoderState
    build [Int
    0 .. Int
    2] where
        build :: Int -> EncoderState
    build Int
    ix = EncoderState
          { _encComponentIndex :: Int
    _encComponentIndex = Int
    ix
          , _encBlockWidth :: Int
    _encBlockWidth     = Int
    1
          , _encBlockHeight :: Int
    _encBlockHeight    = Int
    1
          , _encQuantTable :: MacroBlock Int16
    _encQuantTable     = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    lumaQuantTableAtQuality Int
    qual
          , _encDcHuffman :: HuffmanWriterCode
    _encDcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultDcLumaHuffmanTree
          , _encAcHuffman :: HuffmanWriterCode
    _encAcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultAcLumaHuffmanTree
          }

    instance JpgEncodable PixelCMYK8 where
      additionalBlocks :: Image PixelCMYK8 -> [JpgFrame]
    additionalBlocks Image PixelCMYK8
    _ = [] where
        _adobe14 :: JpgAdobeApp14
    _adobe14 = JpgAdobeApp14
            { _adobeDctVersion :: Word16
    _adobeDctVersion = Word16
    100
            , _adobeFlag0 :: Word16
    _adobeFlag0      = Word16
    32768
            , _adobeFlag1 :: Word16
    _adobeFlag1      = Word16
    0
            , _adobeTransform :: AdobeTransform
    _adobeTransform  = AdobeTransform
    AdobeYCck
            }

      imageHuffmanTables :: Image PixelCMYK8 -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    imageHuffmanTables Image PixelCMYK8
    _ =
        [ DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    DcComponent Word8
    0 HuffmanTable
    defaultDcLumaHuffmanTable
        , DctComponent
    -> Word8
    -> HuffmanTable
    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
    prepareHuffmanTable DctComponent
    AcComponent Word8
    0 HuffmanTable
    defaultAcLumaHuffmanTable
        ]

      scanSpecificationOfColorSpace :: Image PixelCMYK8 -> [JpgScanSpecification]
    scanSpecificationOfColorSpace Image PixelCMYK8
    _ = (Char -> JpgScanSpecification) -> String -> [JpgScanSpecification]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Char -> JpgScanSpecification
    forall {a}. Enum a => a -> JpgScanSpecification
    build String
    "CMYK" where
        build :: a -> JpgScanSpecification
    build a
    c = JpgScanSpecification
          { componentSelector :: Word8
    componentSelector = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c
          , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    0
          , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    0
          }

      componentsOfColorSpace :: Image PixelCMYK8 -> [JpgComponent]
    componentsOfColorSpace Image PixelCMYK8
    _ = (Char -> JpgComponent) -> String -> [JpgComponent]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Char -> JpgComponent
    forall {a}. Enum a => a -> JpgComponent
    build String
    "CMYK" where
        build :: a -> JpgComponent
    build a
    c = JpgComponent
          { componentIdentifier :: Word8
    componentIdentifier      = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ a -> Int
    forall a. Enum a => a -> Int
    fromEnum a
    c
          , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    1
          , verticalSamplingFactor :: Word8
    verticalSamplingFactor   = Word8
    1
          , quantizationTableDest :: Word8
    quantizationTableDest    = Word8
    0
          }

      encodingState :: Int -> Image PixelCMYK8 -> Vector EncoderState
    encodingState Int
    qual Image PixelCMYK8
    _ = Int -> [EncoderState] -> Vector EncoderState
    forall a. Int -> [a] -> Vector a
    V.fromListN Int
    4 ([EncoderState] -> Vector EncoderState)
    -> [EncoderState] -> Vector EncoderState
    forall a b. (a -> b) -> a -> b
    $ (Int -> EncoderState) -> [Int] -> [EncoderState]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> EncoderState
    build [Int
    0 .. Int
    3] where
        build :: Int -> EncoderState
    build Int
    ix = EncoderState
          { _encComponentIndex :: Int
    _encComponentIndex = Int
    ix
          , _encBlockWidth :: Int
    _encBlockWidth     = Int
    1
          , _encBlockHeight :: Int
    _encBlockHeight    = Int
    1
          , _encQuantTable :: MacroBlock Int16
    _encQuantTable     = MacroBlock Int16 -> MacroBlock Int16
    forall a. (Storable a, Num a) => Vector a -> Vector a
    zigZagReorderForwardv (MacroBlock Int16 -> MacroBlock Int16)
    -> MacroBlock Int16 -> MacroBlock Int16
    forall a b. (a -> b) -> a -> b
    $ Int -> MacroBlock Int16
    lumaQuantTableAtQuality Int
    qual
          , _encDcHuffman :: HuffmanWriterCode
    _encDcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultDcLumaHuffmanTree
          , _encAcHuffman :: HuffmanWriterCode
    _encAcHuffman      = HuffmanTree -> HuffmanWriterCode
    makeInverseTable HuffmanTree
    defaultAcLumaHuffmanTree
          }

    -- | Equivalent to 'encodeJpegAtQuality', but will store the following

    -- metadatas in the file using a JFIF block:

    --

    --  * 'Codec.Picture.Metadata.DpiX'

    --  * 'Codec.Picture.Metadata.DpiY'

    --

    encodeJpegAtQualityWithMetadata :: Word8                -- ^ Quality factor

                                    -> Metadatas
                                    -> Image PixelYCbCr8    -- ^ Image to encode

                                    -> L.ByteString         -- ^ Encoded JPEG

    encodeJpegAtQualityWithMetadata :: Word8 -> Metadatas -> Image PixelYCbCr8 -> ByteString
    encodeJpegAtQualityWithMetadata = Word8 -> Metadatas -> Image PixelYCbCr8 -> ByteString
    forall px.
    JpgEncodable px =>
    Word8 -> Metadatas -> Image px -> ByteString
    encodeDirectJpegAtQualityWithMetadata

    -- | Equivalent to 'encodeJpegAtQuality', but will store the following

    -- metadatas in the file using a JFIF block:

    --

    --  * 'Codec.Picture.Metadata.DpiX'

    --  * 'Codec.Picture.Metadata.DpiY'

    --

    -- This function also allow to create JPEG files with the following color

    -- space:

    --

    --  * Y ('Pixel8') for greyscale.

    --  * RGB ('PixelRGB8') with no color downsampling on any plane

    --  * CMYK ('PixelCMYK8') with no color downsampling on any plane

    --

    encodeDirectJpegAtQualityWithMetadata :: forall px. (JpgEncodable px)
                                          => Word8                -- ^ Quality factor

                                          -> Metadatas
                                          -> Image px             -- ^ Image to encode

                                          -> L.ByteString         -- ^ Encoded JPEG

    encodeDirectJpegAtQualityWithMetadata :: forall px.
    JpgEncodable px =>
    Word8 -> Metadatas -> Image px -> ByteString
    encodeDirectJpegAtQualityWithMetadata Word8
    quality Metadatas
    metas Image px
    img = JpgImage -> ByteString
    forall a. Binary a => a -> ByteString
    encode JpgImage
    finalImage where
      !w :: Int
    w = Image px -> Int
    forall a. Image a -> Int
    imageWidth Image px
    img
      !h :: Int
    h = Image px -> Int
    forall a. Image a -> Int
    imageHeight Image px
    img
      !exifMeta :: [JpgFrame]
    exifMeta = case Metadatas -> [ImageFileDirectory]
    encodeTiffStringMetadata Metadatas
    metas of
         [] -> []
         [ImageFileDirectory]
    lst -> [[ImageFileDirectory] -> JpgFrame
    JpgExif [ImageFileDirectory]
    lst]
      finalImage :: JpgImage
    finalImage = [JpgFrame] -> JpgImage
    JpgImage ([JpgFrame] -> JpgImage) -> [JpgFrame] -> JpgImage
    forall a b. (a -> b) -> a -> b
    $
          Metadatas -> [JpgFrame]
    encodeMetadatas Metadatas
    metas [JpgFrame] -> [JpgFrame] -> [JpgFrame]
    forall a. [a] -> [a] -> [a]
    ++
          [JpgFrame]
    exifMeta [JpgFrame] -> [JpgFrame] -> [JpgFrame]
    forall a. [a] -> [a] -> [a]
    ++
          Image px -> [JpgFrame]
    forall px. JpgEncodable px => Image px -> [JpgFrame]
    additionalBlocks Image px
    img [JpgFrame] -> [JpgFrame] -> [JpgFrame]
    forall a. [a] -> [a] -> [a]
    ++
          [ [JpgQuantTableSpec] -> JpgFrame
    JpgQuantTable ([JpgQuantTableSpec] -> JpgFrame)
    -> [JpgQuantTableSpec] -> JpgFrame
    forall a b. (a -> b) -> a -> b
    $ Image px -> Int -> [JpgQuantTableSpec]
    forall px.
    JpgEncodable px =>
    Image px -> Int -> [JpgQuantTableSpec]
    quantTableSpec Image px
    img (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    quality)
          , JpgFrameKind -> JpgFrameHeader -> JpgFrame
    JpgScans JpgFrameKind
    JpgBaselineDCTHuffman JpgFrameHeader
    hdr
          , [(JpgHuffmanTableSpec, HuffmanPackedTree)] -> JpgFrame
    JpgHuffmanTable ([(JpgHuffmanTableSpec, HuffmanPackedTree)] -> JpgFrame)
    -> [(JpgHuffmanTableSpec, HuffmanPackedTree)] -> JpgFrame
    forall a b. (a -> b) -> a -> b
    $ Image px -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    forall px.
    JpgEncodable px =>
    Image px -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    imageHuffmanTables Image px
    img
          , JpgScanHeader -> ByteString -> JpgFrame
    JpgScanBlob JpgScanHeader
    scanHeader ByteString
    encodedImage
          ]

      !outputComponentCount :: Int
    outputComponentCount = px -> Int
    forall a. Pixel a => a -> Int
    componentCount (px
    forall a. HasCallStack => a
    undefined :: px)

      scanHeader :: JpgScanHeader
    scanHeader = JpgScanHeader
    scanHeader'{ scanLength = fromIntegral $ calculateSize scanHeader' }
      scanHeader' :: JpgScanHeader
    scanHeader' = JpgScanHeader
          { scanLength :: Word16
    scanLength = Word16
    0
          , scanComponentCount :: Word8
    scanComponentCount = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    outputComponentCount
          , scans :: [JpgScanSpecification]
    scans = Image px -> [JpgScanSpecification]
    forall px. JpgEncodable px => Image px -> [JpgScanSpecification]
    scanSpecificationOfColorSpace Image px
    img
          , spectralSelection :: (Word8, Word8)
    spectralSelection = (Word8
    0, Word8
    63)
          , successiveApproxHigh :: Word8
    successiveApproxHigh = Word8
    0
          , successiveApproxLow :: Word8
    successiveApproxLow  = Word8
    0
          }

      hdr :: JpgFrameHeader
    hdr = JpgFrameHeader
    hdr' { jpgFrameHeaderLength   = fromIntegral $ calculateSize hdr' }
      hdr' :: JpgFrameHeader
    hdr' = JpgFrameHeader
        { jpgFrameHeaderLength :: Word16
    jpgFrameHeaderLength   = Word16
    0
        , jpgSamplePrecision :: Word8
    jpgSamplePrecision     = Word8
    8
        , jpgHeight :: Word16
    jpgHeight              = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    h
        , jpgWidth :: Word16
    jpgWidth               = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    w
        , jpgImageComponentCount :: Word8
    jpgImageComponentCount = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    outputComponentCount
        , jpgComponents :: [JpgComponent]
    jpgComponents          = Image px -> [JpgComponent]
    forall px. JpgEncodable px => Image px -> [JpgComponent]
    componentsOfColorSpace Image px
    img
        }

      !maxSampling :: Int
    maxSampling = Image px -> Int
    forall px. JpgEncodable px => Image px -> Int
    maximumSubSamplingOf Image px
    img
      !horizontalMetaBlockCount :: Int
    horizontalMetaBlockCount = Int
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `divUpward` (Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxSampling)
      !verticalMetaBlockCount :: Int
    verticalMetaBlockCount = Int
    h Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `divUpward` (Int
    forall a. Num a => a
    dctBlockSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    maxSampling)
      !componentDef :: Vector EncoderState
    componentDef = Int -> Image px -> Vector EncoderState
    forall px.
    JpgEncodable px =>
    Int -> Image px -> Vector EncoderState
    encodingState (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    quality) Image px
    img

      encodedImage :: ByteString
    encodedImage = (forall s. ST s ByteString) -> ByteString
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s ByteString) -> ByteString)
    -> (forall s. ST s ByteString) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        MVector s Int16
    dc_table <- Int -> Int16 -> ST s (MVector (PrimState (ST s)) Int16)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> a -> m (MVector (PrimState m) a)
    M.replicate Int
    outputComponentCount Int16
    0
        MVector s Int16
    block <- ST s (MVector s Int16)
    forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock
        MutableMacroBlock s Int32
    workData <- ST s (MutableMacroBlock s Int32)
    forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock
        MutableMacroBlock s Int32
    zigzaged <- ST s (MutableMacroBlock s Int32)
    forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock
        BoolWriteStateRef s
    writeState <- ST s (BoolWriteStateRef s)
    forall s. ST s (BoolWriteStateRef s)
    newWriteStateRef

        Int -> Int -> (Int -> Int -> ST s ()) -> ST s ()
    forall (m :: * -> *).
    Monad m =>
    Int -> Int -> (Int -> Int -> m ()) -> m ()
    rasterMap Int
    horizontalMetaBlockCount Int
    verticalMetaBlockCount ((Int -> Int -> ST s ()) -> ST s ())
    -> (Int -> Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    mx Int
    my ->
          Vector EncoderState -> (EncoderState -> ST s ()) -> ST s ()
    forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
    V.forM_ Vector EncoderState
    componentDef ((EncoderState -> ST s ()) -> ST s ())
    -> (EncoderState -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \(EncoderState Int
    comp Int
    sizeX Int
    sizeY MacroBlock Int16
    table HuffmanWriterCode
    dc HuffmanWriterCode
    ac) ->
            let !xSamplingFactor :: Int
    xSamplingFactor = Int
    maxSampling Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sizeX Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                !ySamplingFactor :: Int
    ySamplingFactor = Int
    maxSampling Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sizeY Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                !extractor :: Int -> Int -> Int -> ST s (MVector s Int16)
    extractor = Image px
    -> MVector s Int16
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> ST s (MVector s Int16)
    forall s px.
    (PixelBaseComponent px ~ Word8) =>
    Image px
    -> MutableMacroBlock s Int16
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> ST s (MutableMacroBlock s Int16)
    extractBlock Image px
    img MVector s Int16
    block Int
    xSamplingFactor Int
    ySamplingFactor Int
    outputComponentCount
            in
            Int -> Int -> (Int -> Int -> ST s ()) -> ST s ()
    forall (m :: * -> *).
    Monad m =>
    Int -> Int -> (Int -> Int -> m ()) -> m ()
    rasterMap Int
    sizeX Int
    sizeY ((Int -> Int -> ST s ()) -> ST s ())
    -> (Int -> Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    subX Int
    subY -> do
              let !blockY :: Int
    blockY = Int
    my Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sizeY Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    subY
                  !blockX :: Int
    blockX = Int
    mx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    sizeX Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    subX
              Int16
    prev_dc <- MVector s Int16
    MVector (PrimState (ST s)) Int16
    dc_table MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    comp
              MVector s Int16
    extracted <- Int -> Int -> Int -> ST s (MVector s Int16)
    extractor Int
    comp Int
    blockX Int
    blockY
              (Int32
    dc_coeff, MutableMacroBlock s Int32
    neo_block) <- MacroBlock Int16
    -> MutableMacroBlock s Int32
    -> MutableMacroBlock s Int32
    -> Int16
    -> MVector s Int16
    -> ST s (Int32, MutableMacroBlock s Int32)
    forall s.
    MacroBlock Int16
    -> MutableMacroBlock s Int32
    -> MutableMacroBlock s Int32
    -> Int16
    -> MutableMacroBlock s Int16
    -> ST s (Int32, MutableMacroBlock s Int32)
    encodeMacroBlock MacroBlock Int16
    table MutableMacroBlock s Int32
    workData MutableMacroBlock s Int32
    zigzaged Int16
    prev_dc MVector s Int16
    extracted
              (MVector s Int16
    MVector (PrimState (ST s)) Int16
    dc_table MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    comp) (Int16 -> ST s ()) -> Int16 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    dc_coeff
              BoolWriteStateRef s
    -> HuffmanWriterCode
    -> HuffmanWriterCode
    -> MutableMacroBlock s Int32
    -> ST s ()
    forall s.
    BoolWriteStateRef s
    -> HuffmanWriterCode
    -> HuffmanWriterCode
    -> MutableMacroBlock s Int32
    -> ST s ()
    serializeMacroBlock BoolWriteStateRef s
    writeState HuffmanWriterCode
    dc HuffmanWriterCode
    ac MutableMacroBlock s Int32
    neo_block

        BoolWriteStateRef s -> ST s ByteString
    forall s. BoolWriteStateRef s -> ST s ByteString
    finalizeBoolWriter BoolWriteStateRef s
    writeState