    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE CPP #-}
    module Codec.Picture.Jpg.Internal.Types( MutableMacroBlock
                                  , createEmptyMutableMacroBlock
                                  , printMacroBlock
                                  , printPureMacroBlock
                                  , DcCoefficient
                                  , JpgImage( .. )
                                  , JpgComponent( .. )
                                  , JpgFrameHeader( .. )
                                  , JpgFrame( .. )
                                  , JpgFrameKind( .. )
                                  , JpgScanHeader( .. )
                                  , JpgQuantTableSpec( .. )
                                  , JpgHuffmanTableSpec( .. )
                                  , JpgImageKind( .. )
                                  , JpgScanSpecification( .. )
                                  , JpgColorSpace( .. )
                                  , AdobeTransform( .. )
                                  , JpgAdobeApp14( .. )
                                  , JpgJFIFApp0( .. )
                                  , JFifUnit( .. )
                                  , calculateSize
                                  , dctBlockSize
                                  ) where

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

    import Control.Monad( when, replicateM, forM, forM_, unless )
    import Control.Monad.ST( ST )
    import Data.Bits( (.|.), (.&.), unsafeShiftL, unsafeShiftR )
    import Data.List( partition )

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

    import Foreign.Storable ( Storable )
    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.Char8 as BC
    import qualified Data.ByteString.Lazy as L

    import Data.Int( Int16 )
    import Data.Word(Word8, Word16 )
    import Data.Binary( Binary(..) )

    import Data.Binary.Get( Get
                          , getWord8
                          , getWord16be
                          , getByteString
                          , skip
                          , bytesRead
                          )

    import Data.Binary.Put( Put
                          , putWord8
                          , putWord16be
                          , putLazyByteString
                          , putByteString
                          , runPut
                          )

    import Codec.Picture.InternalHelper
    import Codec.Picture.Jpg.Internal.DefaultTable
    import Codec.Picture.Tiff.Internal.Types
    import Codec.Picture.Tiff.Internal.Metadata( exifOffsetIfd )
    import Codec.Picture.Metadata.Exif

    {-import Debug.Trace-}
    import Text.Printf

    -- | Type only used to make clear what kind of integer we are carrying

    -- Might be transformed into newtype in the future

    type DcCoefficient = Int16

    -- | Macroblock that can be transformed.

    type MutableMacroBlock s a = M.STVector s a

    data JpgFrameKind =
          JpgBaselineDCTHuffman
        | JpgExtendedSequentialDCTHuffman
        | JpgProgressiveDCTHuffman
        | JpgLosslessHuffman
        | JpgDifferentialSequentialDCTHuffman
        | JpgDifferentialProgressiveDCTHuffman
        | JpgDifferentialLosslessHuffman
        | JpgExtendedSequentialArithmetic
        | JpgProgressiveDCTArithmetic
        | JpgLosslessArithmetic
        | JpgDifferentialSequentialDCTArithmetic
        | JpgDifferentialProgressiveDCTArithmetic
        | JpgDifferentialLosslessArithmetic
        | JpgQuantizationTable
        | JpgHuffmanTableMarker
        | JpgStartOfScan
        | JpgEndOfImage
        | JpgAppSegment Word8
        | JpgExtensionSegment Word8

        | JpgRestartInterval
        | JpgRestartIntervalEnd Word8
        deriving (JpgFrameKind -> JpgFrameKind -> Bool
    (JpgFrameKind -> JpgFrameKind -> Bool)
    -> (JpgFrameKind -> JpgFrameKind -> Bool) -> Eq JpgFrameKind
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: JpgFrameKind -> JpgFrameKind -> Bool
    == :: JpgFrameKind -> JpgFrameKind -> Bool
    $c/= :: JpgFrameKind -> JpgFrameKind -> Bool
    /= :: JpgFrameKind -> JpgFrameKind -> Bool
    Eq, Int -> JpgFrameKind -> ShowS
    [JpgFrameKind] -> ShowS
    JpgFrameKind -> String
    (Int -> JpgFrameKind -> ShowS)
    -> (JpgFrameKind -> String)
    -> ([JpgFrameKind] -> ShowS)
    -> Show JpgFrameKind
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgFrameKind -> ShowS
    showsPrec :: Int -> JpgFrameKind -> ShowS
    $cshow :: JpgFrameKind -> String
    show :: JpgFrameKind -> String
    $cshowList :: [JpgFrameKind] -> ShowS
    showList :: [JpgFrameKind] -> ShowS
    Show)

    data JpgFrame =
          JpgAppFrame        !Word8 B.ByteString
        | JpgAdobeAPP14      !JpgAdobeApp14
        | JpgJFIF            !JpgJFIFApp0
        | JpgExif            ![ImageFileDirectory]
        | JpgExtension       !Word8 B.ByteString
        | JpgQuantTable      ![JpgQuantTableSpec]
        | JpgHuffmanTable    ![(JpgHuffmanTableSpec, HuffmanPackedTree)]
        | JpgScanBlob        !JpgScanHeader !L.ByteString
        | JpgScans           !JpgFrameKind !JpgFrameHeader
        | JpgIntervalRestart !Word16
        deriving Int -> JpgFrame -> ShowS
    [JpgFrame] -> ShowS
    JpgFrame -> String
    (Int -> JpgFrame -> ShowS)
    -> (JpgFrame -> String) -> ([JpgFrame] -> ShowS) -> Show JpgFrame
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgFrame -> ShowS
    showsPrec :: Int -> JpgFrame -> ShowS
    $cshow :: JpgFrame -> String
    show :: JpgFrame -> String
    $cshowList :: [JpgFrame] -> ShowS
    showList :: [JpgFrame] -> ShowS
    Show

    data JpgColorSpace
      = JpgColorSpaceYCbCr
      | JpgColorSpaceYCC
      | JpgColorSpaceY
      | JpgColorSpaceYA
      | JpgColorSpaceYCCA
      | JpgColorSpaceYCCK
      | JpgColorSpaceCMYK
      | JpgColorSpaceRGB
      | JpgColorSpaceRGBA
      deriving Int -> JpgColorSpace -> ShowS
    [JpgColorSpace] -> ShowS
    JpgColorSpace -> String
    (Int -> JpgColorSpace -> ShowS)
    -> (JpgColorSpace -> String)
    -> ([JpgColorSpace] -> ShowS)
    -> Show JpgColorSpace
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgColorSpace -> ShowS
    showsPrec :: Int -> JpgColorSpace -> ShowS
    $cshow :: JpgColorSpace -> String
    show :: JpgColorSpace -> String
    $cshowList :: [JpgColorSpace] -> ShowS
    showList :: [JpgColorSpace] -> ShowS
    Show

    data AdobeTransform
      = AdobeUnknown    -- ^ Value 0

      | AdobeYCbCr      -- ^ value 1

      | AdobeYCck       -- ^ value 2

      deriving Int -> AdobeTransform -> ShowS
    [AdobeTransform] -> ShowS
    AdobeTransform -> String
    (Int -> AdobeTransform -> ShowS)
    -> (AdobeTransform -> String)
    -> ([AdobeTransform] -> ShowS)
    -> Show AdobeTransform
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AdobeTransform -> ShowS
    showsPrec :: Int -> AdobeTransform -> ShowS
    $cshow :: AdobeTransform -> String
    show :: AdobeTransform -> String
    $cshowList :: [AdobeTransform] -> ShowS
    showList :: [AdobeTransform] -> ShowS
    Show

    data JpgAdobeApp14 = JpgAdobeApp14
      { JpgAdobeApp14 -> Word16
    _adobeDctVersion :: !Word16
      , JpgAdobeApp14 -> Word16
    _adobeFlag0      :: !Word16
      , JpgAdobeApp14 -> Word16
    _adobeFlag1      :: !Word16
      , JpgAdobeApp14 -> AdobeTransform
    _adobeTransform  :: !AdobeTransform
      }
      deriving Int -> JpgAdobeApp14 -> ShowS
    [JpgAdobeApp14] -> ShowS
    JpgAdobeApp14 -> String
    (Int -> JpgAdobeApp14 -> ShowS)
    -> (JpgAdobeApp14 -> String)
    -> ([JpgAdobeApp14] -> ShowS)
    -> Show JpgAdobeApp14
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgAdobeApp14 -> ShowS
    showsPrec :: Int -> JpgAdobeApp14 -> ShowS
    $cshow :: JpgAdobeApp14 -> String
    show :: JpgAdobeApp14 -> String
    $cshowList :: [JpgAdobeApp14] -> ShowS
    showList :: [JpgAdobeApp14] -> ShowS
    Show

    -- | Size: 1

    data JFifUnit
      = JFifUnitUnknown   -- ^ 0

      | JFifPixelsPerInch -- ^ 1

      | JFifPixelsPerCentimeter -- ^ 2

      deriving Int -> JFifUnit -> ShowS
    [JFifUnit] -> ShowS
    JFifUnit -> String
    (Int -> JFifUnit -> ShowS)
    -> (JFifUnit -> String) -> ([JFifUnit] -> ShowS) -> Show JFifUnit
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JFifUnit -> ShowS
    showsPrec :: Int -> JFifUnit -> ShowS
    $cshow :: JFifUnit -> String
    show :: JFifUnit -> String
    $cshowList :: [JFifUnit] -> ShowS
    showList :: [JFifUnit] -> ShowS
    Show

    instance Binary JFifUnit where
      put :: JFifUnit -> Put
    put JFifUnit
    v = Word8 -> Put
    putWord8 (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ case JFifUnit
    v of
        JFifUnit
    JFifUnitUnknown -> Word8
    0
        JFifUnit
    JFifPixelsPerInch -> Word8
    1
        JFifUnit
    JFifPixelsPerCentimeter -> Word8
    2
      get :: Get JFifUnit
    get = do
        Word8
    v <- Get Word8
    getWord8
        JFifUnit -> Get JFifUnit
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JFifUnit -> Get JFifUnit) -> JFifUnit -> Get JFifUnit
    forall a b. (a -> b) -> a -> b
    $ case Word8
    v of
          Word8
    0 -> JFifUnit
    JFifUnitUnknown
          Word8
    1 -> JFifUnit
    JFifPixelsPerInch
          Word8
    2 -> JFifUnit
    JFifPixelsPerCentimeter
          Word8
    _ -> JFifUnit
    JFifUnitUnknown

    data JpgJFIFApp0 = JpgJFIFApp0
      { JpgJFIFApp0 -> JFifUnit
    _jfifUnit      :: !JFifUnit
      , JpgJFIFApp0 -> Word16
    _jfifDpiX      :: !Word16
      , JpgJFIFApp0 -> Word16
    _jfifDpiY      :: !Word16
      , JpgJFIFApp0 -> Maybe Int
    _jfifThumbnail :: !(Maybe {- (Image PixelRGB8) -} Int)
      }
      deriving Int -> JpgJFIFApp0 -> ShowS
    [JpgJFIFApp0] -> ShowS
    JpgJFIFApp0 -> String
    (Int -> JpgJFIFApp0 -> ShowS)
    -> (JpgJFIFApp0 -> String)
    -> ([JpgJFIFApp0] -> ShowS)
    -> Show JpgJFIFApp0
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgJFIFApp0 -> ShowS
    showsPrec :: Int -> JpgJFIFApp0 -> ShowS
    $cshow :: JpgJFIFApp0 -> String
    show :: JpgJFIFApp0 -> String
    $cshowList :: [JpgJFIFApp0] -> ShowS
    showList :: [JpgJFIFApp0] -> ShowS
    Show

    instance Binary JpgJFIFApp0 where
      get :: Get JpgJFIFApp0
    get = do
        ByteString
    sig <- Int -> Get ByteString
    getByteString Int
    5
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString
    sig ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String -> ByteString
    BC.pack String
    "JFIF\0") (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
            String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid JFIF signature"
        Word8
    major <- Get Word8
    getWord8
        Word8
    minor <- Get Word8
    getWord8
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word8
    major Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    1 Bool -> Bool -> Bool
    && Word8
    minor Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word8
    2) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
            String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unrecognize JFIF version"
        JFifUnit
    unit <- Get JFifUnit
    forall t. Binary t => Get t
    get
        Word16
    dpiX <- Get Word16
    getWord16be
        Word16
    dpiY <- Get Word16
    getWord16be
        Word8
    w <- Get Word8
    getWord8
        Word8
    h <- Get Word8
    getWord8
        let pxCount :: Word8
    pxCount = Word8
    3 Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    * Word8
    w Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    * Word8
    h
        Maybe Int
    img <- case Word8
    pxCount of
          Word8
    0 -> Maybe Int -> Get (Maybe Int)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int
    forall a. Maybe a
    Nothing
          Word8
    _ -> Maybe Int -> Get (Maybe Int)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int
    forall a. Maybe a
    Nothing
        JpgJFIFApp0 -> Get JpgJFIFApp0
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JpgJFIFApp0 -> Get JpgJFIFApp0) -> JpgJFIFApp0 -> Get JpgJFIFApp0
    forall a b. (a -> b) -> a -> b
    $ JpgJFIFApp0
            { _jfifUnit :: JFifUnit
    _jfifUnit      = JFifUnit
    unit
            , _jfifDpiX :: Word16
    _jfifDpiX      = Word16
    dpiX
            , _jfifDpiY :: Word16
    _jfifDpiY      = Word16
    dpiY
            , _jfifThumbnail :: Maybe Int
    _jfifThumbnail = Maybe Int
    img
            }

      put :: JpgJFIFApp0 -> Put
    put JpgJFIFApp0
    jfif = do
        ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BC.pack String
    "JFIF\0" -- 5

        Word8 -> Put
    putWord8 Word8
    1                       -- 1 6

        Word8 -> Put
    putWord8 Word8
    2                       -- 1 7

        JFifUnit -> Put
    forall t. Binary t => t -> Put
    put (JFifUnit -> Put) -> JFifUnit -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgJFIFApp0 -> JFifUnit
    _jfifUnit JpgJFIFApp0
    jfif             -- 1 8

        Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgJFIFApp0 -> Word16
    _jfifDpiX JpgJFIFApp0
    jfif     -- 2 10

        Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgJFIFApp0 -> Word16
    _jfifDpiY JpgJFIFApp0
    jfif     -- 2 12

        Word8 -> Put
    putWord8 Word8
    0                       -- 1 13

        Word8 -> Put
    putWord8 Word8
    0                       -- 1 14

    {-Thumbnail width (tw) 	1 	Horizontal size of embedded JFIF thumbnail in pixels-}
    {-Thumbnail height (th) 	1 	Vertical size of embedded JFIF thumbnail in pixels-}
    {-Thumbnail data 	3 × tw × th 	Uncompressed 24 bit RGB raster thumbnail-}

    instance Binary AdobeTransform where
      put :: AdobeTransform -> Put
    put AdobeTransform
    v = case AdobeTransform
    v of
        AdobeTransform
    AdobeUnknown -> Word8 -> Put
    putWord8 Word8
    0
        AdobeTransform
    AdobeYCbCr -> Word8 -> Put
    putWord8 Word8
    1
        AdobeTransform
    AdobeYCck -> Word8 -> Put
    putWord8 Word8
    2

      get :: Get AdobeTransform
    get = do
        Word8
    v <- Get Word8
    getWord8
        AdobeTransform -> Get AdobeTransform
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (AdobeTransform -> Get AdobeTransform)
    -> AdobeTransform -> Get AdobeTransform
    forall a b. (a -> b) -> a -> b
    $ case Word8
    v of
          Word8
    0 -> AdobeTransform
    AdobeUnknown
          Word8
    1 -> AdobeTransform
    AdobeYCbCr
          Word8
    2 -> AdobeTransform
    AdobeYCck
          Word8
    _ -> AdobeTransform
    AdobeUnknown

    instance Binary JpgAdobeApp14 where
      get :: Get JpgAdobeApp14
    get = do
        let sig :: ByteString
    sig = String -> ByteString
    BC.pack String
    "Adobe"
        ByteString
    fileSig <- Int -> Get ByteString
    getByteString Int
    5
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString
    fileSig ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    sig) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
           String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid Adobe APP14 marker"
        Word16
    version <- Get Word16
    getWord16be
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word16
    version Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word16
    100) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
           String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get ()) -> String -> Get ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid Adobe APP14 version " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word16 -> String
    forall a. Show a => a -> String
    show Word16
    version
        Word16 -> Word16 -> Word16 -> AdobeTransform -> JpgAdobeApp14
    JpgAdobeApp14 Word16
    version
                      (Word16 -> Word16 -> AdobeTransform -> JpgAdobeApp14)
    -> Get Word16 -> Get (Word16 -> AdobeTransform -> JpgAdobeApp14)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word16
    getWord16be
                      Get (Word16 -> AdobeTransform -> JpgAdobeApp14)
    -> Get Word16 -> Get (AdobeTransform -> JpgAdobeApp14)
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get Word16
    getWord16be Get (AdobeTransform -> JpgAdobeApp14)
    -> Get AdobeTransform -> Get JpgAdobeApp14
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get AdobeTransform
    forall t. Binary t => Get t
    get

      put :: JpgAdobeApp14 -> Put
    put (JpgAdobeApp14 Word16
    v Word16
    f0 Word16
    f1 AdobeTransform
    t) = do
        ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BC.pack String
    "Adobe"
        Word16 -> Put
    putWord16be Word16
    v
        Word16 -> Put
    putWord16be Word16
    f0
        Word16 -> Put
    putWord16be Word16
    f1
        AdobeTransform -> Put
    forall t. Binary t => t -> Put
    put AdobeTransform
    t

    data JpgFrameHeader = JpgFrameHeader
        { JpgFrameHeader -> Word16
    jpgFrameHeaderLength   :: !Word16
        , JpgFrameHeader -> Word8
    jpgSamplePrecision     :: !Word8
        , JpgFrameHeader -> Word16
    jpgHeight              :: !Word16
        , JpgFrameHeader -> Word16
    jpgWidth               :: !Word16
        , JpgFrameHeader -> Word8
    jpgImageComponentCount :: !Word8
        , JpgFrameHeader -> [JpgComponent]
    jpgComponents          :: ![JpgComponent]
        }
        deriving Int -> JpgFrameHeader -> ShowS
    [JpgFrameHeader] -> ShowS
    JpgFrameHeader -> String
    (Int -> JpgFrameHeader -> ShowS)
    -> (JpgFrameHeader -> String)
    -> ([JpgFrameHeader] -> ShowS)
    -> Show JpgFrameHeader
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgFrameHeader -> ShowS
    showsPrec :: Int -> JpgFrameHeader -> ShowS
    $cshow :: JpgFrameHeader -> String
    show :: JpgFrameHeader -> String
    $cshowList :: [JpgFrameHeader] -> ShowS
    showList :: [JpgFrameHeader] -> ShowS
    Show

    instance SizeCalculable JpgFrameHeader where
        calculateSize :: JpgFrameHeader -> Int
    calculateSize JpgFrameHeader
    hdr = Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                          Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [JpgComponent -> Int
    forall a. SizeCalculable a => a -> Int
    calculateSize JpgComponent
    c | JpgComponent
    c <- JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    hdr]

    data JpgComponent = JpgComponent
        { JpgComponent -> Word8
    componentIdentifier       :: !Word8
          -- | Stored with 4 bits

        , JpgComponent -> Word8
    horizontalSamplingFactor  :: !Word8
          -- | Stored with 4 bits

        , JpgComponent -> Word8
    verticalSamplingFactor    :: !Word8
        , JpgComponent -> Word8
    quantizationTableDest     :: !Word8
        }
        deriving Int -> JpgComponent -> ShowS
    [JpgComponent] -> ShowS
    JpgComponent -> String
    (Int -> JpgComponent -> ShowS)
    -> (JpgComponent -> String)
    -> ([JpgComponent] -> ShowS)
    -> Show JpgComponent
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgComponent -> ShowS
    showsPrec :: Int -> JpgComponent -> ShowS
    $cshow :: JpgComponent -> String
    show :: JpgComponent -> String
    $cshowList :: [JpgComponent] -> ShowS
    showList :: [JpgComponent] -> ShowS
    Show

    instance SizeCalculable JpgComponent where
        calculateSize :: JpgComponent -> Int
    calculateSize JpgComponent
    _ = Int
    3

    data JpgImage = JpgImage { JpgImage -> [JpgFrame]
    jpgFrame :: [JpgFrame] }
        deriving Int -> JpgImage -> ShowS
    [JpgImage] -> ShowS
    JpgImage -> String
    (Int -> JpgImage -> ShowS)
    -> (JpgImage -> String) -> ([JpgImage] -> ShowS) -> Show JpgImage
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgImage -> ShowS
    showsPrec :: Int -> JpgImage -> ShowS
    $cshow :: JpgImage -> String
    show :: JpgImage -> String
    $cshowList :: [JpgImage] -> ShowS
    showList :: [JpgImage] -> ShowS
    Show

    data JpgScanSpecification = JpgScanSpecification
        { JpgScanSpecification -> Word8
    componentSelector :: !Word8
          -- | Encoded as 4 bits

        , JpgScanSpecification -> Word8
    dcEntropyCodingTable :: !Word8
          -- | Encoded as 4 bits

        , JpgScanSpecification -> Word8
    acEntropyCodingTable :: !Word8

        }
        deriving Int -> JpgScanSpecification -> ShowS
    [JpgScanSpecification] -> ShowS
    JpgScanSpecification -> String
    (Int -> JpgScanSpecification -> ShowS)
    -> (JpgScanSpecification -> String)
    -> ([JpgScanSpecification] -> ShowS)
    -> Show JpgScanSpecification
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgScanSpecification -> ShowS
    showsPrec :: Int -> JpgScanSpecification -> ShowS
    $cshow :: JpgScanSpecification -> String
    show :: JpgScanSpecification -> String
    $cshowList :: [JpgScanSpecification] -> ShowS
    showList :: [JpgScanSpecification] -> ShowS
    Show

    instance SizeCalculable JpgScanSpecification where
        calculateSize :: JpgScanSpecification -> Int
    calculateSize JpgScanSpecification
    _ = Int
    2

    data JpgScanHeader = JpgScanHeader
        { JpgScanHeader -> Word16
    scanLength :: !Word16
        , JpgScanHeader -> Word8
    scanComponentCount :: !Word8
        , JpgScanHeader -> [JpgScanSpecification]
    scans :: [JpgScanSpecification]

          -- | (begin, end)

        , JpgScanHeader -> (Word8, Word8)
    spectralSelection    :: (Word8, Word8)

          -- | Encoded as 4 bits

        , JpgScanHeader -> Word8
    successiveApproxHigh :: !Word8

          -- | Encoded as 4 bits

        , JpgScanHeader -> Word8
    successiveApproxLow :: !Word8
        }
        deriving Int -> JpgScanHeader -> ShowS
    [JpgScanHeader] -> ShowS
    JpgScanHeader -> String
    (Int -> JpgScanHeader -> ShowS)
    -> (JpgScanHeader -> String)
    -> ([JpgScanHeader] -> ShowS)
    -> Show JpgScanHeader
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgScanHeader -> ShowS
    showsPrec :: Int -> JpgScanHeader -> ShowS
    $cshow :: JpgScanHeader -> String
    show :: JpgScanHeader -> String
    $cshowList :: [JpgScanHeader] -> ShowS
    showList :: [JpgScanHeader] -> ShowS
    Show

    instance SizeCalculable JpgScanHeader where
        calculateSize :: JpgScanHeader -> Int
    calculateSize JpgScanHeader
    hdr = Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                          Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [JpgScanSpecification -> Int
    forall a. SizeCalculable a => a -> Int
    calculateSize JpgScanSpecification
    c | JpgScanSpecification
    c <- JpgScanHeader -> [JpgScanSpecification]
    scans JpgScanHeader
    hdr]
                          Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
                          Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

    data JpgQuantTableSpec = JpgQuantTableSpec
        { -- | Stored on 4 bits

          JpgQuantTableSpec -> Word8
    quantPrecision     :: !Word8

          -- | Stored on 4 bits

        , JpgQuantTableSpec -> Word8
    quantDestination   :: !Word8

        , JpgQuantTableSpec -> MacroBlock Int16
    quantTable         :: MacroBlock Int16
        }
        deriving Int -> JpgQuantTableSpec -> ShowS
    [JpgQuantTableSpec] -> ShowS
    JpgQuantTableSpec -> String
    (Int -> JpgQuantTableSpec -> ShowS)
    -> (JpgQuantTableSpec -> String)
    -> ([JpgQuantTableSpec] -> ShowS)
    -> Show JpgQuantTableSpec
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgQuantTableSpec -> ShowS
    showsPrec :: Int -> JpgQuantTableSpec -> ShowS
    $cshow :: JpgQuantTableSpec -> String
    show :: JpgQuantTableSpec -> String
    $cshowList :: [JpgQuantTableSpec] -> ShowS
    showList :: [JpgQuantTableSpec] -> ShowS
    Show

    class SizeCalculable a where
        calculateSize :: a -> Int

    -- | Type introduced only to avoid some typeclass overlapping

    -- problem

    newtype TableList a = TableList [a]

    instance (SizeCalculable a, Binary a) => Binary (TableList a) where
        put :: TableList a -> Put
    put (TableList [a]
    lst) = do
            Word16 -> Put
    putWord16be (Word16 -> Put) -> (Int -> Word16) -> Int -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Put) -> Int -> Put
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [a -> Int
    forall a. SizeCalculable a => a -> Int
    calculateSize a
    table | a
    table <- [a]
    lst] Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
            (a -> Put) -> [a] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ a -> Put
    forall t. Binary t => t -> Put
    put [a]
    lst

        get :: Get (TableList a)
    get = [a] -> TableList a
    forall a. [a] -> TableList a
    TableList ([a] -> TableList a) -> Get [a] -> Get (TableList a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Get Word16
    getWord16be Get Word16 -> (Word16 -> Get [a]) -> Get [a]
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Word16
    s -> Int -> Get [a]
    innerParse (Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2))
          where innerParse :: Int -> Get [a]
                innerParse :: Int -> Get [a]
    innerParse Int
    0    = [a] -> Get [a]
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                innerParse Int
    size = do
                    Int
    onStart <- Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Get Int64 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Int64
    bytesRead
                    a
    table <- Get a
    forall t. Binary t => Get t
    get
                    Int
    onEnd <- Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Get Int64 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Int64
    bytesRead
                    (a
    table a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [a]) -> Get [a] -> Get [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get [a]
    innerParse (Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    onEnd Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    onStart))

    instance SizeCalculable JpgQuantTableSpec where
        calculateSize :: JpgQuantTableSpec -> Int
    calculateSize JpgQuantTableSpec
    table =
            Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (JpgQuantTableSpec -> Word8
    quantPrecision JpgQuantTableSpec
    table) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    64

    instance Binary JpgQuantTableSpec where
        put :: JpgQuantTableSpec -> Put
    put JpgQuantTableSpec
    table = do
            let precision :: Word8
    precision = JpgQuantTableSpec -> Word8
    quantPrecision JpgQuantTableSpec
    table
            Word8 -> Word8 -> Put
    put4BitsOfEach Word8
    precision (JpgQuantTableSpec -> Word8
    quantDestination JpgQuantTableSpec
    table)
            [Int16] -> (Int16 -> Put) -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (MacroBlock Int16 -> [Int16]
    forall a. Storable a => Vector a -> [a]
    VS.toList (MacroBlock Int16 -> [Int16]) -> MacroBlock Int16 -> [Int16]
    forall a b. (a -> b) -> a -> b
    $ JpgQuantTableSpec -> MacroBlock Int16
    quantTable JpgQuantTableSpec
    table) ((Int16 -> Put) -> Put) -> (Int16 -> Put) -> Put
    forall a b. (a -> b) -> a -> b
    $ \Int16
    coeff ->
                if Word8
    precision Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0 then Word8 -> Put
    putWord8 (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ Int16 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int16
    coeff
                                 else Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ Int16 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int16
    coeff

        get :: Get JpgQuantTableSpec
    get = do
            (Word8
    precision, Word8
    dest) <- Get (Word8, Word8)
    get4BitOfEach
            [Int16]
    coeffs <- Int -> Get Int16 -> Get [Int16]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    64 (Get Int16 -> Get [Int16]) -> Get Int16 -> Get [Int16]
    forall a b. (a -> b) -> a -> b
    $ if Word8
    precision Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0
                    then Word8 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int16) -> Get Word8 -> Get Int16
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word8
    getWord8
                    else Word16 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int16) -> Get Word16 -> Get Int16
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word16
    getWord16be
            JpgQuantTableSpec -> Get JpgQuantTableSpec
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgQuantTableSpec
                { quantPrecision :: Word8
    quantPrecision = Word8
    precision
                , quantDestination :: Word8
    quantDestination = Word8
    dest
                , quantTable :: MacroBlock Int16
    quantTable = Int -> [Int16] -> MacroBlock Int16
    forall a. Storable a => Int -> [a] -> Vector a
    VS.fromListN Int
    64 [Int16]
    coeffs
                }

    data JpgHuffmanTableSpec = JpgHuffmanTableSpec
        { -- | 0 : DC, 1 : AC, stored on 4 bits

          JpgHuffmanTableSpec -> DctComponent
    huffmanTableClass       :: !DctComponent
          -- | Stored on 4 bits

        , JpgHuffmanTableSpec -> Word8
    huffmanTableDest        :: !Word8

        , JpgHuffmanTableSpec -> Vector Word8
    huffSizes :: !(VU.Vector Word8)
        , JpgHuffmanTableSpec -> Vector (Vector Word8)
    huffCodes :: !(V.Vector (VU.Vector Word8))
        }
        deriving Int -> JpgHuffmanTableSpec -> ShowS
    [JpgHuffmanTableSpec] -> ShowS
    JpgHuffmanTableSpec -> String
    (Int -> JpgHuffmanTableSpec -> ShowS)
    -> (JpgHuffmanTableSpec -> String)
    -> ([JpgHuffmanTableSpec] -> ShowS)
    -> Show JpgHuffmanTableSpec
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> JpgHuffmanTableSpec -> ShowS
    showsPrec :: Int -> JpgHuffmanTableSpec -> ShowS
    $cshow :: JpgHuffmanTableSpec -> String
    show :: JpgHuffmanTableSpec -> String
    $cshowList :: [JpgHuffmanTableSpec] -> ShowS
    showList :: [JpgHuffmanTableSpec] -> ShowS
    Show

    instance SizeCalculable JpgHuffmanTableSpec where
        calculateSize :: JpgHuffmanTableSpec -> Int
    calculateSize JpgHuffmanTableSpec
    table = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    16 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    e | Word8
    e <- Vector Word8 -> [Word8]
    forall a. Unbox a => Vector a -> [a]
    VU.toList (Vector Word8 -> [Word8]) -> Vector Word8 -> [Word8]
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Vector Word8
    huffSizes JpgHuffmanTableSpec
    table]

    instance Binary JpgHuffmanTableSpec where
        put :: JpgHuffmanTableSpec -> Put
    put JpgHuffmanTableSpec
    table = do
            let classVal :: Word8
    classVal = if JpgHuffmanTableSpec -> DctComponent
    huffmanTableClass JpgHuffmanTableSpec
    table DctComponent -> DctComponent -> Bool
    forall a. Eq a => a -> a -> Bool
    == DctComponent
    DcComponent
                              then Word8
    0 else Word8
    1
            Word8 -> Word8 -> Put
    put4BitsOfEach Word8
    classVal (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Word8
    huffmanTableDest JpgHuffmanTableSpec
    table
            (Word8 -> Put) -> [Word8] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Word8 -> Put
    forall t. Binary t => t -> Put
    put ([Word8] -> Put)
    -> (Vector Word8 -> [Word8]) -> Vector Word8 -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Word8 -> [Word8]
    forall a. Unbox a => Vector a -> [a]
    VU.toList (Vector Word8 -> Put) -> Vector Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Vector Word8
    huffSizes JpgHuffmanTableSpec
    table
            [Int] -> (Int -> Put) -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    15] ((Int -> Put) -> Put) -> (Int -> Put) -> Put
    forall a b. (a -> b) -> a -> b
    $ \Int
    i ->
                Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (JpgHuffmanTableSpec -> Vector Word8
    huffSizes JpgHuffmanTableSpec
    table Vector Word8 -> Int -> Word8
    forall a. Unbox a => Vector a -> Int -> a
    ! Int
    i Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    0)
                     (let elements :: [Word8]
    elements = Vector Word8 -> [Word8]
    forall a. Unbox a => Vector a -> [a]
    VU.toList (Vector Word8 -> [Word8]) -> Vector Word8 -> [Word8]
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Vector (Vector Word8)
    huffCodes JpgHuffmanTableSpec
    table Vector (Vector Word8) -> Int -> Vector Word8
    forall a. Vector a -> Int -> a
    V.! Int
    i
                      in (Word8 -> Put) -> [Word8] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Word8 -> Put
    forall t. Binary t => t -> Put
    put [Word8]
    elements)

        get :: Get JpgHuffmanTableSpec
    get = do
            (Word8
    huffClass, Word8
    huffDest) <- Get (Word8, Word8)
    get4BitOfEach
            [Word8]
    sizes <- Int -> Get Word8 -> Get [Word8]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    16 Get Word8
    getWord8
            [Vector Word8]
    codes <- [Word8] -> (Word8 -> Get (Vector Word8)) -> Get [Vector Word8]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Word8]
    sizes ((Word8 -> Get (Vector Word8)) -> Get [Vector Word8])
    -> (Word8 -> Get (Vector Word8)) -> Get [Vector Word8]
    forall a b. (a -> b) -> a -> b
    $ \Word8
    s ->
                Int -> Get Word8 -> Get (Vector Word8)
    forall (m :: * -> *) a.
    (Monad m, Unbox a) =>
    Int -> m a -> m (Vector a)
    VU.replicateM (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    s) Get Word8
    getWord8
            JpgHuffmanTableSpec -> Get JpgHuffmanTableSpec
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgHuffmanTableSpec
                { huffmanTableClass :: DctComponent
    huffmanTableClass =
                    if Word8
    huffClass Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0 then DctComponent
    DcComponent else DctComponent
    AcComponent
                , huffmanTableDest :: Word8
    huffmanTableDest = Word8
    huffDest
                , huffSizes :: Vector Word8
    huffSizes = Int -> [Word8] -> Vector Word8
    forall a. Unbox a => Int -> [a] -> Vector a
    VU.fromListN Int
    16 [Word8]
    sizes
                , huffCodes :: Vector (Vector Word8)
    huffCodes = Int -> [Vector Word8] -> Vector (Vector Word8)
    forall a. Int -> [a] -> Vector a
    V.fromListN Int
    16 [Vector Word8]
    codes
                }

    instance Binary JpgImage where
        put :: JpgImage -> Put
    put (JpgImage { jpgFrame :: JpgImage -> [JpgFrame]
    jpgFrame = [JpgFrame]
    frames }) =
            Word8 -> Put
    putWord8 Word8
    0xFF Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    putWord8 Word8
    0xD8 Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (JpgFrame -> Put) -> [JpgFrame] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ JpgFrame -> Put
    putFrame [JpgFrame]
    frames
                Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    putWord8 Word8
    0xFF Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    putWord8 Word8
    0xD9

        get :: Get JpgImage
    get = do
            let startOfImageMarker :: Word8
    startOfImageMarker = Word8
    0xD8
                -- endOfImageMarker = 0xD9

            Word8 -> Word8 -> Get ()
    checkMarker Word8
    commonMarkerFirstByte Word8
    startOfImageMarker
            Get ()
    eatUntilCode
            [JpgFrame]
    frames <- Get [JpgFrame]
    parseFrames
            {-checkMarker commonMarkerFirstByte endOfImageMarker-}
            JpgImage -> Get JpgImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgImage { jpgFrame :: [JpgFrame]
    jpgFrame = [JpgFrame]
    frames }

    eatUntilCode :: Get ()
    eatUntilCode :: Get ()
    eatUntilCode = do
        Word8
    code <- Get Word8
    getWord8
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Word8
    code Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0xFF) Get ()
    eatUntilCode

    takeCurrentFrame :: Get B.ByteString
    takeCurrentFrame :: Get ByteString
    takeCurrentFrame = do
        Word16
    size <- Get Word16
    getWord16be
        Int -> Get ByteString
    getByteString (Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2)

    putFrame :: JpgFrame -> Put
    putFrame :: JpgFrame -> Put
    putFrame (JpgAdobeAPP14 JpgAdobeApp14
    adobe) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> JpgFrameKind
    JpgAppSegment Word8
    14) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word16 -> Put
    putWord16be Word16
    14 Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> JpgAdobeApp14 -> Put
    forall t. Binary t => t -> Put
    put JpgAdobeApp14
    adobe
    putFrame (JpgJFIF JpgJFIFApp0
    jfif) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> JpgFrameKind
    JpgAppSegment Word8
    0) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word16 -> Put
    putWord16be (Word16
    14Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    +Word16
    2) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> JpgJFIFApp0 -> Put
    forall t. Binary t => t -> Put
    put JpgJFIFApp0
    jfif
    putFrame (JpgExif [ImageFileDirectory]
    exif) = [ImageFileDirectory] -> Put
    putExif [ImageFileDirectory]
    exif
    putFrame (JpgAppFrame Word8
    appCode ByteString
    str) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> JpgFrameKind
    JpgAppSegment Word8
    appCode) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word16 -> Put
    putWord16be (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    str) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    str
    putFrame (JpgExtension Word8
    appCode ByteString
    str) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> JpgFrameKind
    JpgExtensionSegment Word8
    appCode) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word16 -> Put
    putWord16be (Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    str) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    str
    putFrame (JpgQuantTable [JpgQuantTableSpec]
    tables) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put JpgFrameKind
    JpgQuantizationTable Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TableList JpgQuantTableSpec -> Put
    forall t. Binary t => t -> Put
    put ([JpgQuantTableSpec] -> TableList JpgQuantTableSpec
    forall a. [a] -> TableList a
    TableList [JpgQuantTableSpec]
    tables)
    putFrame (JpgHuffmanTable [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    tables) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put JpgFrameKind
    JpgHuffmanTableMarker Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TableList JpgHuffmanTableSpec -> Put
    forall t. Binary t => t -> Put
    put ([JpgHuffmanTableSpec] -> TableList JpgHuffmanTableSpec
    forall a. [a] -> TableList a
    TableList ([JpgHuffmanTableSpec] -> TableList JpgHuffmanTableSpec)
    -> [JpgHuffmanTableSpec] -> TableList JpgHuffmanTableSpec
    forall a b. (a -> b) -> a -> b
    $ ((JpgHuffmanTableSpec, HuffmanPackedTree) -> JpgHuffmanTableSpec)
    -> [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    -> [JpgHuffmanTableSpec]
    forall a b. (a -> b) -> [a] -> [b]
    map (JpgHuffmanTableSpec, HuffmanPackedTree) -> JpgHuffmanTableSpec
    forall a b. (a, b) -> a
    fst [(JpgHuffmanTableSpec, HuffmanPackedTree)]
    tables)
    putFrame (JpgIntervalRestart Word16
    size) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put JpgFrameKind
    JpgRestartInterval Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> RestartInterval -> Put
    forall t. Binary t => t -> Put
    put (Word16 -> RestartInterval
    RestartInterval Word16
    size)
    putFrame (JpgScanBlob JpgScanHeader
    hdr ByteString
    blob) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put JpgFrameKind
    JpgStartOfScan Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> JpgScanHeader -> Put
    forall t. Binary t => t -> Put
    put JpgScanHeader
    hdr Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Put
    putLazyByteString ByteString
    blob
    putFrame (JpgScans JpgFrameKind
    kind JpgFrameHeader
    hdr) =
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put JpgFrameKind
    kind Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> JpgFrameHeader -> Put
    forall t. Binary t => t -> Put
    put JpgFrameHeader
    hdr

    --------------------------------------------------

    ----            Serialization instances

    --------------------------------------------------

    commonMarkerFirstByte :: Word8
    commonMarkerFirstByte :: Word8
    commonMarkerFirstByte = Word8
    0xFF

    checkMarker :: Word8 -> Word8 -> Get ()
    checkMarker :: Word8 -> Word8 -> Get ()
    checkMarker Word8
    b1 Word8
    b2 = do
        Word8
    rb1 <- Get Word8
    getWord8
        Word8
    rb2 <- Get Word8
    getWord8
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word8
    rb1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    b1 Bool -> Bool -> Bool
    || Word8
    rb2 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    b2)
             (String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid marker used")

    extractScanContent :: L.ByteString -> (L.ByteString, L.ByteString)
    extractScanContent :: ByteString -> (ByteString, ByteString)
    extractScanContent ByteString
    str = Int64 -> (ByteString, ByteString)
    aux Int64
    0
      where maxi :: Int64
    maxi = Int64 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int64) -> Int64 -> Int64
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    str Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Int64
    1

            aux :: Int64 -> (ByteString, ByteString)
    aux Int64
    n | Int64
    n Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int64
    maxi = (ByteString
    str, ByteString
    L.empty)
                  | Word8
    v Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0xFF Bool -> Bool -> Bool
    && Word8
    vNext Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    0 Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    isReset = Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt Int64
    n ByteString
    str
                  | Bool
    otherwise = Int64 -> (ByteString, ByteString)
    aux (Int64
    n Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    1)
                where v :: Word8
    v = ByteString
    str HasCallStack => ByteString -> Int64 -> Word8
    ByteString -> Int64 -> Word8
    `L.index` Int64
    n
                      vNext :: Word8
    vNext = ByteString
    str HasCallStack => ByteString -> Int64 -> Word8
    ByteString -> Int64 -> Word8
    `L.index` (Int64
    n Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    1)
                      isReset :: Bool
    isReset = Word8
    0xD0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    vNext Bool -> Bool -> Bool
    && Word8
    vNext Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xD7

    parseAdobe14 :: B.ByteString -> [JpgFrame] -> [JpgFrame]
    parseAdobe14 :: ByteString -> [JpgFrame] -> [JpgFrame]
    parseAdobe14 ByteString
    str [JpgFrame]
    lst = [JpgFrame]
    go where
      go :: [JpgFrame]
    go = case Get JpgAdobeApp14 -> ByteString -> Either String JpgAdobeApp14
    forall a. Get a -> ByteString -> Either String a
    runGetStrict Get JpgAdobeApp14
    forall t. Binary t => Get t
    get ByteString
    str of
        Left String
    _err -> [JpgFrame]
    lst
        Right JpgAdobeApp14
    app14 -> JpgAdobeApp14 -> JpgFrame
    JpgAdobeAPP14 JpgAdobeApp14
    app14 JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst

    -- | Parse JFIF or JFXX information. Right now only JFIF.

    parseJF__  :: B.ByteString -> [JpgFrame] -> [JpgFrame]
    parseJF__ :: ByteString -> [JpgFrame] -> [JpgFrame]
    parseJF__  ByteString
    str [JpgFrame]
    lst = [JpgFrame]
    go where
      go :: [JpgFrame]
    go = case Get JpgJFIFApp0 -> ByteString -> Either String JpgJFIFApp0
    forall a. Get a -> ByteString -> Either String a
    runGetStrict Get JpgJFIFApp0
    forall t. Binary t => Get t
    get ByteString
    str of
        Left String
    _err -> [JpgFrame]
    lst
        Right JpgJFIFApp0
    jfif -> JpgJFIFApp0 -> JpgFrame
    JpgJFIF JpgJFIFApp0
    jfif JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst

    parseExif :: B.ByteString -> [JpgFrame] -> [JpgFrame]
    parseExif :: ByteString -> [JpgFrame] -> [JpgFrame]
    parseExif ByteString
    str [JpgFrame]
    lst
      | ByteString
    exifHeader ByteString -> ByteString -> Bool
    `B.isPrefixOf` ByteString
    str = [JpgFrame]
    go
      | Bool
    otherwise = [JpgFrame]
    lst
      where
        exifHeader :: ByteString
    exifHeader = String -> ByteString
    BC.pack String
    "Exif\0\0"
        tiff :: ByteString
    tiff = Int -> ByteString -> ByteString
    B.drop (ByteString -> Int
    B.length ByteString
    exifHeader) ByteString
    str
        go :: [JpgFrame]
    go = case Get (TiffHeader, [[ImageFileDirectory]])
    -> ByteString -> Either String (TiffHeader, [[ImageFileDirectory]])
    forall a. Get a -> ByteString -> Either String a
    runGetStrict (ByteString -> Get (TiffHeader, [[ImageFileDirectory]])
    forall a b. BinaryParam a b => a -> Get b
    getP ByteString
    tiff) ByteString
    tiff of
          Left String
    _err -> [JpgFrame]
    lst
          Right (TiffHeader
    _hdr :: TiffHeader, []) -> [JpgFrame]
    lst
          Right (TiffHeader
    _hdr :: TiffHeader, [ImageFileDirectory]
    ifds : [[ImageFileDirectory]]
    _) -> [ImageFileDirectory] -> JpgFrame
    JpgExif [ImageFileDirectory]
    ifds JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst

    putExif :: [ImageFileDirectory] -> Put
    putExif :: [ImageFileDirectory] -> Put
    putExif [ImageFileDirectory]
    ifds = Put
    putAll where
      hdr :: TiffHeader
    hdr = TiffHeader
        { hdrEndianness :: Endianness
    hdrEndianness = Endianness
    EndianBig
        , hdrOffset :: Word32
    hdrOffset = Word32
    8
        }

      ifdList :: [[ImageFileDirectory]]
    ifdList = case (ImageFileDirectory -> Bool)
    -> [ImageFileDirectory]
    -> ([ImageFileDirectory], [ImageFileDirectory])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (ExifTag -> Bool
    isInIFD0 (ExifTag -> Bool)
    -> (ImageFileDirectory -> ExifTag) -> ImageFileDirectory -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImageFileDirectory -> ExifTag
    ifdIdentifier) [ImageFileDirectory]
    ifds of
        ([ImageFileDirectory]
    ifd0, []) -> [[ImageFileDirectory]
    ifd0]
        ([ImageFileDirectory]
    ifd0, [ImageFileDirectory]
    ifdExif) -> [[ImageFileDirectory]
    ifd0 [ImageFileDirectory]
    -> [ImageFileDirectory] -> [ImageFileDirectory]
    forall a. Semigroup a => a -> a -> a
    <> ImageFileDirectory -> [ImageFileDirectory]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ImageFileDirectory
    exifOffsetIfd, [ImageFileDirectory]
    ifdExif]

      exifBlob :: ByteString
    exifBlob = Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BC.pack String
    "Exif\0\0"
        ByteString -> (TiffHeader, [[ImageFileDirectory]]) -> Put
    forall a b. BinaryParam a b => a -> b -> Put
    putP ByteString
    BC.empty (TiffHeader
    hdr, [[ImageFileDirectory]]
    ifdList)

      putAll :: Put
    putAll = do
        JpgFrameKind -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> JpgFrameKind
    JpgAppSegment Word8
    1)
        Word16 -> Put
    putWord16be (Word16 -> Put) -> (Int64 -> Word16) -> Int64 -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Put) -> Int64 -> Put
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    exifBlob Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    2
        ByteString -> Put
    putLazyByteString ByteString
    exifBlob

    parseFrames :: Get [JpgFrame]
    parseFrames :: Get [JpgFrame]
    parseFrames = do
        JpgFrameKind
    kind <- Get JpgFrameKind
    forall t. Binary t => Get t
    get
        let parseNextFrame :: Get [JpgFrame]
    parseNextFrame = do
                Word8
    word <- Get Word8
    getWord8
                Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word8
    word Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    0xFF) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $ do
                    Int64
    readedData <- Get Int64
    bytesRead
                    String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get ()) -> String -> Get ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid Frame marker (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String
    forall a. Show a => a -> String
    show Word8
    word
                         String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", bytes read : " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int64 -> String
    forall a. Show a => a -> String
    show Int64
    readedData String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                Get [JpgFrame]
    parseFrames

        case JpgFrameKind
    kind of
            JpgFrameKind
    JpgEndOfImage -> [JpgFrame] -> Get [JpgFrame]
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            JpgAppSegment Word8
    0 ->
                ByteString -> [JpgFrame] -> [JpgFrame]
    parseJF__ (ByteString -> [JpgFrame] -> [JpgFrame])
    -> Get ByteString -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    takeCurrentFrame Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgAppSegment Word8
    1 ->
                ByteString -> [JpgFrame] -> [JpgFrame]
    parseExif (ByteString -> [JpgFrame] -> [JpgFrame])
    -> Get ByteString -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    takeCurrentFrame Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgAppSegment Word8
    14 ->
                ByteString -> [JpgFrame] -> [JpgFrame]
    parseAdobe14 (ByteString -> [JpgFrame] -> [JpgFrame])
    -> Get ByteString -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    takeCurrentFrame Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgAppSegment Word8
    c ->
                (\ByteString
    frm [JpgFrame]
    lst -> Word8 -> ByteString -> JpgFrame
    JpgAppFrame Word8
    c ByteString
    frm JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst) (ByteString -> [JpgFrame] -> [JpgFrame])
    -> Get ByteString -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    takeCurrentFrame Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgExtensionSegment Word8
    c ->
                (\ByteString
    frm [JpgFrame]
    lst -> Word8 -> ByteString -> JpgFrame
    JpgExtension Word8
    c ByteString
    frm JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst) (ByteString -> [JpgFrame] -> [JpgFrame])
    -> Get ByteString -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    takeCurrentFrame Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgFrameKind
    JpgQuantizationTable ->
                (\(TableList [JpgQuantTableSpec]
    quants) [JpgFrame]
    lst -> [JpgQuantTableSpec] -> JpgFrame
    JpgQuantTable [JpgQuantTableSpec]
    quants JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst) (TableList JpgQuantTableSpec -> [JpgFrame] -> [JpgFrame])
    -> Get (TableList JpgQuantTableSpec)
    -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get (TableList JpgQuantTableSpec)
    forall t. Binary t => Get t
    get Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgFrameKind
    JpgRestartInterval ->
                (\(RestartInterval Word16
    i) [JpgFrame]
    lst -> Word16 -> JpgFrame
    JpgIntervalRestart Word16
    i JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst) (RestartInterval -> [JpgFrame] -> [JpgFrame])
    -> Get RestartInterval -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get RestartInterval
    forall t. Binary t => Get t
    get Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgFrameKind
    JpgHuffmanTableMarker ->
                (\(TableList [JpgHuffmanTableSpec]
    huffTables) [JpgFrame]
    lst ->
                        [(JpgHuffmanTableSpec, HuffmanPackedTree)] -> JpgFrame
    JpgHuffmanTable [(JpgHuffmanTableSpec
    t, HuffmanTree -> HuffmanPackedTree
    packHuffmanTree (HuffmanTree -> HuffmanPackedTree)
    -> (Vector (Vector Word8) -> HuffmanTree)
    -> Vector (Vector Word8)
    -> HuffmanPackedTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector (Vector Word8) -> HuffmanTree
    buildPackedHuffmanTree (Vector (Vector Word8) -> HuffmanPackedTree)
    -> Vector (Vector Word8) -> HuffmanPackedTree
    forall a b. (a -> b) -> a -> b
    $ JpgHuffmanTableSpec -> Vector (Vector Word8)
    huffCodes JpgHuffmanTableSpec
    t) | JpgHuffmanTableSpec
    t <- [JpgHuffmanTableSpec]
    huffTables] JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst)
                        (TableList JpgHuffmanTableSpec -> [JpgFrame] -> [JpgFrame])
    -> Get (TableList JpgHuffmanTableSpec)
    -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get (TableList JpgHuffmanTableSpec)
    forall t. Binary t => Get t
    get Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame
            JpgFrameKind
    JpgStartOfScan ->
                (\JpgScanHeader
    frm ByteString
    imgData ->
                    let (ByteString
    d, ByteString
    other) = ByteString -> (ByteString, ByteString)
    extractScanContent ByteString
    imgData
                    in
                    case Get [JpgFrame] -> ByteString -> Either String [JpgFrame]
    forall a. Get a -> ByteString -> Either String a
    runGet Get [JpgFrame]
    parseFrames (Int64 -> ByteString -> ByteString
    L.drop Int64
    1 ByteString
    other) of
                      Left String
    _ -> [JpgScanHeader -> ByteString -> JpgFrame
    JpgScanBlob JpgScanHeader
    frm ByteString
    d]
                      Right [JpgFrame]
    lst -> JpgScanHeader -> ByteString -> JpgFrame
    JpgScanBlob JpgScanHeader
    frm ByteString
    d JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst
                ) (JpgScanHeader -> ByteString -> [JpgFrame])
    -> Get JpgScanHeader -> Get (ByteString -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get JpgScanHeader
    forall t. Binary t => Get t
    get Get (ByteString -> [JpgFrame]) -> Get ByteString -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get ByteString
    getRemainingLazyBytes

            JpgFrameKind
    _ -> (\JpgFrameHeader
    hdr [JpgFrame]
    lst -> JpgFrameKind -> JpgFrameHeader -> JpgFrame
    JpgScans JpgFrameKind
    kind JpgFrameHeader
    hdr JpgFrame -> [JpgFrame] -> [JpgFrame]
    forall a. a -> [a] -> [a]
    : [JpgFrame]
    lst) (JpgFrameHeader -> [JpgFrame] -> [JpgFrame])
    -> Get JpgFrameHeader -> Get ([JpgFrame] -> [JpgFrame])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get JpgFrameHeader
    forall t. Binary t => Get t
    get Get ([JpgFrame] -> [JpgFrame]) -> Get [JpgFrame] -> Get [JpgFrame]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [JpgFrame]
    parseNextFrame

    buildPackedHuffmanTree :: V.Vector (VU.Vector Word8) -> HuffmanTree
    buildPackedHuffmanTree :: Vector (Vector Word8) -> HuffmanTree
    buildPackedHuffmanTree = [[Word8]] -> HuffmanTree
    buildHuffmanTree ([[Word8]] -> HuffmanTree)
    -> (Vector (Vector Word8) -> [[Word8]])
    -> Vector (Vector Word8)
    -> HuffmanTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Vector Word8 -> [Word8]) -> [Vector Word8] -> [[Word8]]
    forall a b. (a -> b) -> [a] -> [b]
    map Vector Word8 -> [Word8]
    forall a. Unbox a => Vector a -> [a]
    VU.toList ([Vector Word8] -> [[Word8]])
    -> (Vector (Vector Word8) -> [Vector Word8])
    -> Vector (Vector Word8)
    -> [[Word8]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector (Vector Word8) -> [Vector Word8]
    forall a. Vector a -> [a]
    V.toList

    secondStartOfFrameByteOfKind :: JpgFrameKind -> Word8
    secondStartOfFrameByteOfKind :: JpgFrameKind -> Word8
    secondStartOfFrameByteOfKind = JpgFrameKind -> Word8
    aux
      where
        aux :: JpgFrameKind -> Word8
    aux JpgFrameKind
    JpgBaselineDCTHuffman = Word8
    0xC0
        aux JpgFrameKind
    JpgExtendedSequentialDCTHuffman = Word8
    0xC1
        aux JpgFrameKind
    JpgProgressiveDCTHuffman = Word8
    0xC2
        aux JpgFrameKind
    JpgLosslessHuffman = Word8
    0xC3
        aux JpgFrameKind
    JpgDifferentialSequentialDCTHuffman = Word8
    0xC5
        aux JpgFrameKind
    JpgDifferentialProgressiveDCTHuffman = Word8
    0xC6
        aux JpgFrameKind
    JpgDifferentialLosslessHuffman = Word8
    0xC7
        aux JpgFrameKind
    JpgExtendedSequentialArithmetic = Word8
    0xC9
        aux JpgFrameKind
    JpgProgressiveDCTArithmetic = Word8
    0xCA
        aux JpgFrameKind
    JpgLosslessArithmetic = Word8
    0xCB
        aux JpgFrameKind
    JpgHuffmanTableMarker = Word8
    0xC4
        aux JpgFrameKind
    JpgDifferentialSequentialDCTArithmetic = Word8
    0xCD
        aux JpgFrameKind
    JpgDifferentialProgressiveDCTArithmetic = Word8
    0xCE
        aux JpgFrameKind
    JpgDifferentialLosslessArithmetic = Word8
    0xCF
        aux JpgFrameKind
    JpgEndOfImage = Word8
    0xD9
        aux JpgFrameKind
    JpgQuantizationTable = Word8
    0xDB
        aux JpgFrameKind
    JpgStartOfScan = Word8
    0xDA
        aux JpgFrameKind
    JpgRestartInterval = Word8
    0xDD
        aux (JpgRestartIntervalEnd Word8
    v) = Word8
    v
        aux (JpgAppSegment Word8
    a) = (Word8
    a Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    0xE0)
        aux (JpgExtensionSegment Word8
    a) = Word8
    a

    data JpgImageKind = BaseLineDCT | ProgressiveDCT

    instance Binary JpgFrameKind where
        put :: JpgFrameKind -> Put
    put JpgFrameKind
    v = Word8 -> Put
    putWord8 Word8
    0xFF Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put (JpgFrameKind -> Word8
    secondStartOfFrameByteOfKind JpgFrameKind
    v)
        get :: Get JpgFrameKind
    get = do
            -- no lookahead :(

            {-word <- getWord8-}
            Word8
    word2 <- Get Word8
    getWord8
            case Word8
    word2 of
                Word8
    0xC0 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgBaselineDCTHuffman
                Word8
    0xC1 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgExtendedSequentialDCTHuffman
                Word8
    0xC2 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgProgressiveDCTHuffman
                Word8
    0xC3 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgLosslessHuffman
                Word8
    0xC4 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgHuffmanTableMarker
                Word8
    0xC5 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgDifferentialSequentialDCTHuffman
                Word8
    0xC6 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgDifferentialProgressiveDCTHuffman
                Word8
    0xC7 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgDifferentialLosslessHuffman
                Word8
    0xC9 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgExtendedSequentialArithmetic
                Word8
    0xCA -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgProgressiveDCTArithmetic
                Word8
    0xCB -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgLosslessArithmetic
                Word8
    0xCD -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgDifferentialSequentialDCTArithmetic
                Word8
    0xCE -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgDifferentialProgressiveDCTArithmetic
                Word8
    0xCF -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgDifferentialLosslessArithmetic
                Word8
    0xD9 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgEndOfImage
                Word8
    0xDA -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgStartOfScan
                Word8
    0xDB -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgQuantizationTable
                Word8
    0xDD -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameKind
    JpgRestartInterval
                Word8
    a | Word8
    a Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    0xF0 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JpgFrameKind -> Get JpgFrameKind)
    -> JpgFrameKind -> Get JpgFrameKind
    forall a b. (a -> b) -> a -> b
    $! Word8 -> JpgFrameKind
    JpgExtensionSegment Word8
    a
                  | Word8
    a Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    0xE0 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JpgFrameKind -> Get JpgFrameKind)
    -> JpgFrameKind -> Get JpgFrameKind
    forall a b. (a -> b) -> a -> b
    $! Word8 -> JpgFrameKind
    JpgAppSegment (Word8
    a Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    0xE0)
                  | Word8
    a Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    0xD0 Bool -> Bool -> Bool
    && Word8
    a Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xD7 -> JpgFrameKind -> Get JpgFrameKind
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JpgFrameKind -> Get JpgFrameKind)
    -> JpgFrameKind -> Get JpgFrameKind
    forall a b. (a -> b) -> a -> b
    $! Word8 -> JpgFrameKind
    JpgRestartIntervalEnd Word8
    a
                  | Bool
    otherwise -> String -> Get JpgFrameKind
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Invalid frame marker (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String
    forall a. Show a => a -> String
    show Word8
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")")

    put4BitsOfEach :: Word8 -> Word8 -> Put
    put4BitsOfEach :: Word8 -> Word8 -> Put
    put4BitsOfEach Word8
    a Word8
    b = Word8 -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ (Word8
    a Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    4) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    b

    get4BitOfEach :: Get (Word8, Word8)
    get4BitOfEach :: Get (Word8, Word8)
    get4BitOfEach = do
        Word8
    val <- Get Word8
    forall t. Binary t => Get t
    get
        (Word8, Word8) -> Get (Word8, Word8)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Word8
    val Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF, Word8
    val Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF)

    newtype RestartInterval = RestartInterval Word16

    instance Binary RestartInterval where
        put :: RestartInterval -> Put
    put (RestartInterval Word16
    i) = Word16 -> Put
    putWord16be Word16
    4 Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word16 -> Put
    putWord16be Word16
    i
        get :: Get RestartInterval
    get = do
            Word16
    size <- Get Word16
    getWord16be
            Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word16
    size Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word16
    4) (String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid jpeg restart interval size")
            Word16 -> RestartInterval
    RestartInterval (Word16 -> RestartInterval) -> Get Word16 -> Get RestartInterval
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word16
    getWord16be

    instance Binary JpgComponent where
        get :: Get JpgComponent
    get = do
            Word8
    ident <- Get Word8
    getWord8
            (Word8
    horiz, Word8
    vert) <- Get (Word8, Word8)
    get4BitOfEach
            Word8
    quantTableIndex <- Get Word8
    getWord8
            JpgComponent -> Get JpgComponent
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgComponent
                { componentIdentifier :: Word8
    componentIdentifier = Word8
    ident
                , horizontalSamplingFactor :: Word8
    horizontalSamplingFactor = Word8
    horiz
                , verticalSamplingFactor :: Word8
    verticalSamplingFactor = Word8
    vert
                , quantizationTableDest :: Word8
    quantizationTableDest = Word8
    quantTableIndex
                }
        put :: JpgComponent -> Put
    put JpgComponent
    v = do
            Word8 -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgComponent -> Word8
    componentIdentifier JpgComponent
    v
            Word8 -> Word8 -> Put
    put4BitsOfEach (JpgComponent -> Word8
    horizontalSamplingFactor JpgComponent
    v) (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgComponent -> Word8
    verticalSamplingFactor JpgComponent
    v
            Word8 -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgComponent -> Word8
    quantizationTableDest JpgComponent
    v

    instance Binary JpgFrameHeader where
        get :: Get JpgFrameHeader
    get = do
            Int
    beginOffset <- Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Get Int64 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Int64
    bytesRead
            Word16
    frmHLength <- Get Word16
    getWord16be
            Word8
    samplePrec <- Get Word8
    getWord8
            Word16
    h <- Get Word16
    getWord16be
            Word16
    w <- Get Word16
    getWord16be
            Word8
    compCount <- Get Word8
    getWord8
            [JpgComponent]
    components <- Int -> Get JpgComponent -> Get [JpgComponent]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    compCount) Get JpgComponent
    forall t. Binary t => Get t
    get
            Int
    endOffset <- Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Get Int64 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Int64
    bytesRead
            Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    beginOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    endOffset Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    frmHLength)
                 (Int -> Get ()
    skip (Int -> Get ()) -> Int -> Get ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    frmHLength Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    endOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    beginOffset))
            JpgFrameHeader -> Get JpgFrameHeader
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgFrameHeader
                { jpgFrameHeaderLength :: Word16
    jpgFrameHeaderLength = Word16
    frmHLength
                , jpgSamplePrecision :: Word8
    jpgSamplePrecision = Word8
    samplePrec
                , jpgHeight :: Word16
    jpgHeight = Word16
    h
                , jpgWidth :: Word16
    jpgWidth = Word16
    w
                , jpgImageComponentCount :: Word8
    jpgImageComponentCount = Word8
    compCount
                , jpgComponents :: [JpgComponent]
    jpgComponents = [JpgComponent]
    components
                }

        put :: JpgFrameHeader -> Put
    put JpgFrameHeader
    v = do
            Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgFrameHeaderLength JpgFrameHeader
    v
            Word8 -> Put
    putWord8    (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word8
    jpgSamplePrecision JpgFrameHeader
    v
            Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgHeight JpgFrameHeader
    v
            Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word16
    jpgWidth JpgFrameHeader
    v
            Word8 -> Put
    putWord8    (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> Word8
    jpgImageComponentCount JpgFrameHeader
    v
            (JpgComponent -> Put) -> [JpgComponent] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ JpgComponent -> Put
    forall t. Binary t => t -> Put
    put   ([JpgComponent] -> Put) -> [JpgComponent] -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgFrameHeader -> [JpgComponent]
    jpgComponents JpgFrameHeader
    v

    instance Binary JpgScanSpecification where
        put :: JpgScanSpecification -> Put
    put JpgScanSpecification
    v = do
            Word8 -> Put
    forall t. Binary t => t -> Put
    put (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanSpecification -> Word8
    componentSelector JpgScanSpecification
    v
            Word8 -> Word8 -> Put
    put4BitsOfEach (JpgScanSpecification -> Word8
    dcEntropyCodingTable JpgScanSpecification
    v) (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanSpecification -> Word8
    acEntropyCodingTable JpgScanSpecification
    v

        get :: Get JpgScanSpecification
    get = do
            Word8
    compSel <- Get Word8
    forall t. Binary t => Get t
    get
            (Word8
    dc, Word8
    ac) <- Get (Word8, Word8)
    get4BitOfEach
            JpgScanSpecification -> Get JpgScanSpecification
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgScanSpecification {
                componentSelector :: Word8
    componentSelector = Word8
    compSel
              , dcEntropyCodingTable :: Word8
    dcEntropyCodingTable = Word8
    dc
              , acEntropyCodingTable :: Word8
    acEntropyCodingTable = Word8
    ac
              }

    instance Binary JpgScanHeader where
        get :: Get JpgScanHeader
    get = do
            Word16
    thisScanLength <- Get Word16
    getWord16be
            Word8
    compCount <- Get Word8
    getWord8
            [JpgScanSpecification]
    comp <- Int -> Get JpgScanSpecification -> Get [JpgScanSpecification]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    compCount) Get JpgScanSpecification
    forall t. Binary t => Get t
    get
            Word8
    specBeg <- Get Word8
    forall t. Binary t => Get t
    get
            Word8
    specEnd <- Get Word8
    forall t. Binary t => Get t
    get
            (Word8
    approxHigh, Word8
    approxLow) <- Get (Word8, Word8)
    get4BitOfEach

            JpgScanHeader -> Get JpgScanHeader
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JpgScanHeader {
                scanLength :: Word16
    scanLength = Word16
    thisScanLength,
                scanComponentCount :: Word8
    scanComponentCount = Word8
    compCount,
                scans :: [JpgScanSpecification]
    scans = [JpgScanSpecification]
    comp,
                spectralSelection :: (Word8, Word8)
    spectralSelection = (Word8
    specBeg, Word8
    specEnd),
                successiveApproxHigh :: Word8
    successiveApproxHigh = Word8
    approxHigh,
                successiveApproxLow :: Word8
    successiveApproxLow = Word8
    approxLow
            }

        put :: JpgScanHeader -> Put
    put JpgScanHeader
    v = do
            Word16 -> Put
    putWord16be (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> Word16
    scanLength JpgScanHeader
    v
            Word8 -> Put
    putWord8 (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> Word8
    scanComponentCount JpgScanHeader
    v
            (JpgScanSpecification -> Put) -> [JpgScanSpecification] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ JpgScanSpecification -> Put
    forall t. Binary t => t -> Put
    put ([JpgScanSpecification] -> Put) -> [JpgScanSpecification] -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> [JpgScanSpecification]
    scans JpgScanHeader
    v
            Word8 -> Put
    putWord8 (Word8 -> Put)
    -> ((Word8, Word8) -> Word8) -> (Word8, Word8) -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8, Word8) -> Word8
    forall a b. (a, b) -> a
    fst ((Word8, Word8) -> Put) -> (Word8, Word8) -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> (Word8, Word8)
    spectralSelection JpgScanHeader
    v
            Word8 -> Put
    putWord8 (Word8 -> Put)
    -> ((Word8, Word8) -> Word8) -> (Word8, Word8) -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8, Word8) -> Word8
    forall a b. (a, b) -> b
    snd ((Word8, Word8) -> Put) -> (Word8, Word8) -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> (Word8, Word8)
    spectralSelection JpgScanHeader
    v
            Word8 -> Word8 -> Put
    put4BitsOfEach (JpgScanHeader -> Word8
    successiveApproxHigh JpgScanHeader
    v) (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ JpgScanHeader -> Word8
    successiveApproxLow JpgScanHeader
    v

    {-# INLINE createEmptyMutableMacroBlock #-}
    -- | Create a new macroblock with the good array size

    createEmptyMutableMacroBlock :: (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock :: forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
    createEmptyMutableMacroBlock = Int -> a -> ST s (MVector (PrimState (ST s)) a)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> a -> m (MVector (PrimState m) a)
    M.replicate Int
    64 a
    0

    printMacroBlock :: (Storable a, PrintfArg a)
                    => MutableMacroBlock s a -> ST s String
    printMacroBlock :: forall a s.
    (Storable a, PrintfArg a) =>
    MutableMacroBlock s a -> ST s String
    printMacroBlock MutableMacroBlock s a
    block = Int -> ST s String
    pLn Int
    0
        where pLn :: Int -> ST s String
    pLn Int
    64 = String -> ST s String
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "===============================\n"
              pLn Int
    i = do
                  a
    v <- MutableMacroBlock s a
    MVector (PrimState (ST s)) a
    block MVector (PrimState (ST s)) a -> Int -> ST s a
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    i
                  String
    vn <- Int -> ST s String
    pLn (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
                  String -> ST s String
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> ST s String) -> String -> ST s String
    forall a b. (a -> b) -> a -> b
    $ String -> a -> String
    forall r. PrintfType r => String -> r
    printf (if Int
    i Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then String
    "\n%5d " else String
    "%5d ") a
    v String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    vn

    printPureMacroBlock :: (Storable a, PrintfArg a) => MacroBlock a -> String
    printPureMacroBlock :: forall a. (Storable a, PrintfArg a) => MacroBlock a -> String
    printPureMacroBlock MacroBlock a
    block = Int -> String
    pLn Int
    0
        where pLn :: Int -> String
    pLn Int
    64 = String
    "===============================\n"
              pLn Int
    i = String
    str String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    pLn (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                where str :: String
    str | Int
    i Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    8 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = String -> a -> String
    forall r. PrintfType r => String -> r
    printf String
    "\n%5d " a
    v
                          | Bool
    otherwise = String -> a -> String
    forall r. PrintfType r => String -> r
    printf String
    "%5d" a
    v
                      v :: a
    v = MacroBlock a
    block MacroBlock a -> Int -> a
    forall a. Storable a => Vector a -> Int -> a
    VS.! Int
    i

    {-# INLINE dctBlockSize #-}
    dctBlockSize :: Num a => a
    dctBlockSize :: forall a. Num a => a
    dctBlockSize = a
    8