{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Module used by the jpeg decoder internally, shouldn't be used

-- in user code.

module Codec.Picture.Jpg.Internal.DefaultTable( DctComponent( .. )
                                     , HuffmanTree( .. )
                                     , HuffmanTable
                                     , HuffmanPackedTree
                                     , MacroBlock
                                     , QuantificationTable
                                     , HuffmanWriterCode 
                                     , scaleQuantisationMatrix
                                     , makeMacroBlock
                                     , makeInverseTable
                                     , buildHuffmanTree
                                     , packHuffmanTree
                                     , huffmanPackedDecode

                                     , defaultChromaQuantizationTable

                                     , defaultLumaQuantizationTable

                                     , defaultAcChromaHuffmanTree
                                     , defaultAcChromaHuffmanTable

                                     , defaultAcLumaHuffmanTree 
                                     , defaultAcLumaHuffmanTable 

                                     , defaultDcChromaHuffmanTree 
                                     , defaultDcChromaHuffmanTable

                                     , defaultDcLumaHuffmanTree
                                     , defaultDcLumaHuffmanTable
                                     ) where

import Data.Int( Int16 )
import Foreign.Storable ( Storable )
import Control.Monad.ST( runST )
import qualified Data.Vector.Storable as SV
import qualified Data.Vector as V
import Data.Bits( unsafeShiftL, (.|.), (.&.) )
import Data.Word( Word8, Word16 )
import Data.List( foldl' )
import qualified Data.Vector.Storable.Mutable as M

import Codec.Picture.BitWriter

-- | Tree storing the code used for huffman encoding.

data HuffmanTree = Branch HuffmanTree HuffmanTree -- ^ If bit is 0 take the first subtree, if 1, the right.

                 | Leaf Word8       -- ^ We should output the value

                 | Empty            -- ^ no value present

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

type HuffmanPackedTree = SV.Vector Word16

type HuffmanWriterCode = V.Vector (Word8, Word16)

packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
packHuffmanTree tree :: HuffmanTree
tree = (forall s. ST s HuffmanPackedTree) -> HuffmanPackedTree
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s HuffmanPackedTree) -> HuffmanPackedTree)
-> (forall s. ST s HuffmanPackedTree) -> HuffmanPackedTree
forall a b. (a -> b) -> a -> b
$ do
    MVector s Word16
table <- Int -> Word16 -> ST s (MVector (PrimState (ST s)) Word16)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate 512 0x8000
    let aux :: HuffmanTree -> Int -> ST s Int
aux (HuffmanTree
Empty) idx :: Int
idx = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
        aux (Leaf v :: Word8
v) idx :: Int
idx = do
            (MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
idx) (Word16 -> ST s ()) -> Word16 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. 0x4000
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

        aux (Branch i1 :: HuffmanTree
i1@(Leaf _) i2 :: HuffmanTree
i2@(Leaf _)) idx :: Int
idx =
            HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 Int
idx ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2

        aux (Branch i1 :: HuffmanTree
i1@(Leaf _) i2 :: HuffmanTree
i2) idx :: Int
idx = do
            Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 Int
idx
            Int
ix2 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
            (MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (Word16 -> ST s ()) -> Word16 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix2

        aux (Branch i1 :: HuffmanTree
i1 i2 :: HuffmanTree
i2@(Leaf _)) idx :: Int
idx = do
            Int
ix1 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
            Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
            (MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
idx) (Word16 -> ST s ()) -> (Int -> Word16) -> Int -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix1

        aux (Branch i1 :: HuffmanTree
i1 i2 :: HuffmanTree
i2) idx :: Int
idx = do
            Int
ix1 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
            Int
ix2 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 Int
ix1
            (MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
idx) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
            (MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix1)
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix2
    Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
tree 0
    MVector (PrimState (ST s)) Word16 -> ST s HuffmanPackedTree
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
SV.unsafeFreeze MVector s Word16
MVector (PrimState (ST s)) Word16
table

makeInverseTable :: HuffmanTree -> HuffmanWriterCode
makeInverseTable :: HuffmanTree -> HuffmanWriterCode
makeInverseTable t :: HuffmanTree
t = Int -> (Word8, Word16) -> HuffmanWriterCode
forall a. Int -> a -> Vector a
V.replicate 255 (0,0) HuffmanWriterCode -> [(Int, (Word8, Word16))] -> HuffmanWriterCode
forall a. Vector a -> [(Int, a)] -> Vector a
V.// Word8 -> Word16 -> HuffmanTree -> [(Int, (Word8, Word16))]
forall a a a.
(Num a, Num a, Num a, Bits a) =>
a -> a -> HuffmanTree -> [(a, (a, a))]
inner 0 0 HuffmanTree
t
  where inner :: a -> a -> HuffmanTree -> [(a, (a, a))]
inner _     _     Empty   = []
        inner depth :: a
depth code :: a
code (Leaf v :: Word8
v) = [(Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v, (a
depth, a
code))]
        inner depth :: a
depth code :: a
code (Branch l :: HuffmanTree
l r :: HuffmanTree
r) =
          a -> a -> HuffmanTree -> [(a, (a, a))]
inner (a
depth a -> a -> a
forall a. Num a => a -> a -> a
+ 1) a
shifted HuffmanTree
l [(a, (a, a))] -> [(a, (a, a))] -> [(a, (a, a))]
forall a. [a] -> [a] -> [a]
++ a -> a -> HuffmanTree -> [(a, (a, a))]
inner (a
depth a -> a -> a
forall a. Num a => a -> a -> a
+ 1) (a
shifted a -> a -> a
forall a. Bits a => a -> a -> a
.|. 1) HuffmanTree
r
            where shifted :: a
shifted = a
code a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 1

-- | Represent a compact array of 8 * 8 values. The size

-- is not guarenteed by type system, but if makeMacroBlock is

-- used, everything should be fine size-wise

type MacroBlock a = SV.Vector a

type QuantificationTable = MacroBlock Int16

-- | Helper function to create pure macro block of the good size.

makeMacroBlock :: (Storable a) => [a] -> MacroBlock a
makeMacroBlock :: [a] -> MacroBlock a
makeMacroBlock = Int -> [a] -> MacroBlock a
forall a. Storable a => Int -> [a] -> Vector a
SV.fromListN 64

-- | Enumeration used to search in the tables for different components.

data DctComponent = DcComponent | AcComponent
    deriving (DctComponent -> DctComponent -> Bool
(DctComponent -> DctComponent -> Bool)
-> (DctComponent -> DctComponent -> Bool) -> Eq DctComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DctComponent -> DctComponent -> Bool
$c/= :: DctComponent -> DctComponent -> Bool
== :: DctComponent -> DctComponent -> Bool
$c== :: DctComponent -> DctComponent -> Bool
Eq, Int -> DctComponent -> ShowS
[DctComponent] -> ShowS
DctComponent -> String
(Int -> DctComponent -> ShowS)
-> (DctComponent -> String)
-> ([DctComponent] -> ShowS)
-> Show DctComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DctComponent] -> ShowS
$cshowList :: [DctComponent] -> ShowS
show :: DctComponent -> String
$cshow :: DctComponent -> String
showsPrec :: Int -> DctComponent -> ShowS
$cshowsPrec :: Int -> DctComponent -> ShowS
Show)

-- | Transform parsed coefficients from the jpeg header to a

-- tree which can be used to decode data.

buildHuffmanTree :: [[Word8]] -> HuffmanTree
buildHuffmanTree :: [[Word8]] -> HuffmanTree
buildHuffmanTree table :: [[Word8]]
table = (HuffmanTree -> (Int, Word8) -> HuffmanTree)
-> HuffmanTree -> [(Int, Word8)] -> HuffmanTree
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HuffmanTree -> (Int, Word8) -> HuffmanTree
forall a. (Eq a, Num a) => HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
Empty
                       ([(Int, Word8)] -> HuffmanTree)
-> ([(Int, [Word8])] -> [(Int, Word8)])
-> [(Int, [Word8])]
-> HuffmanTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Word8]) -> [(Int, Word8)])
-> [(Int, [Word8])] -> [(Int, Word8)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(i :: Int
i, t :: [Word8]
t) -> (Word8 -> (Int, Word8)) -> [Word8] -> [(Int, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1,) [Word8]
t)
                       ([(Int, [Word8])] -> HuffmanTree)
-> [(Int, [Word8])] -> HuffmanTree
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Word8]] -> [(Int, [Word8])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([0..] :: [Int]) [[Word8]]
table
  where isTreeFullyDefined :: HuffmanTree -> Bool
isTreeFullyDefined Empty = Bool
False
        isTreeFullyDefined (Leaf _) = Bool
True
        isTreeFullyDefined (Branch l :: HuffmanTree
l r :: HuffmanTree
r) = HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
l Bool -> Bool -> Bool
&& HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
r

        insertHuffmanVal :: HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal Empty (0, val :: Word8
val) = Word8 -> HuffmanTree
Leaf Word8
val
        insertHuffmanVal Empty (d :: a
d, val :: Word8
val) = HuffmanTree -> HuffmanTree -> HuffmanTree
Branch (HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
Empty (a
d a -> a -> a
forall a. Num a => a -> a -> a
- 1, Word8
val)) HuffmanTree
Empty
        insertHuffmanVal (Branch l :: HuffmanTree
l r :: HuffmanTree
r) (d :: a
d, val :: Word8
val)
            | HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
l = HuffmanTree -> HuffmanTree -> HuffmanTree
Branch HuffmanTree
l (HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
r (a
d a -> a -> a
forall a. Num a => a -> a -> a
- 1, Word8
val))
            | Bool
otherwise            = HuffmanTree -> HuffmanTree -> HuffmanTree
Branch (HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
l (a
d a -> a -> a
forall a. Num a => a -> a -> a
- 1, Word8
val)) HuffmanTree
r
        insertHuffmanVal (Leaf _) _ = String -> HuffmanTree
forall a. HasCallStack => String -> a
error "Inserting in value, shouldn't happen"

scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable 
scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix quality :: Int
quality
    | Int
quality Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix 0
        -- shouldn't show much difference than with 1,

        -- but hey, at least we're complete

    | Int
quality Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall a a c. (Integral a, Integral a, Num c) => a -> a -> c
scale (10000 :: Int))
    | Int
quality Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 50 = let qq :: Int
qq = 5000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
quality
                     in (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall a a c. (Integral a, Integral a, Num c) => a -> a -> c
scale Int
qq)
    | Bool
otherwise    = (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall a a c. (Integral a, Integral a, Num c) => a -> a -> c
scale Int
q)
          where q :: Int
q = 200 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
quality Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
                scale :: a -> a -> c
scale coeff :: a
coeff i :: a
i = a -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> c) -> (a -> a) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
min 255 
                                             (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max 1 
                                             (a -> c) -> a -> c
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i a -> a -> a
forall a. Num a => a -> a -> a
* a
coeff a -> a -> a
forall a. Integral a => a -> a -> a
`div` 100

huffmanPackedDecode :: HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode :: HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode table :: HuffmanPackedTree
table = BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg BoolReader s Bool
-> (Bool -> BoolReader s Word8) -> BoolReader s Word8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Bool -> BoolReader s Word8
forall a s. Num a => Word16 -> Bool -> StateT BoolState (ST s) a
aux 0
  where aux :: Word16 -> Bool -> StateT BoolState (ST s) a
aux idx :: Word16
idx b :: Bool
b
            | (Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x8000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return  0
            | (Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x4000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> StateT BoolState (ST s) a)
-> (Word16 -> a) -> Word16 -> StateT BoolState (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> StateT BoolState (ST s) a)
-> Word16 -> StateT BoolState (ST s) a
forall a b. (a -> b) -> a -> b
$ Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0xFF
            | Bool
otherwise = BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg BoolReader s Bool
-> (Bool -> StateT BoolState (ST s) a) -> StateT BoolState (ST s) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Bool -> StateT BoolState (ST s) a
aux Word16
v
          where tableIndex :: Word16
tableIndex | Bool
b = Word16
idx Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ 1
                           | Bool
otherwise = Word16
idx
                v :: Word16
v = HuffmanPackedTree
table HuffmanPackedTree -> Int -> Word16
forall a. Storable a => Vector a -> Int -> a
`SV.unsafeIndex` Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
tableIndex

defaultLumaQuantizationTable :: QuantificationTable
defaultLumaQuantizationTable :: QuantificationTable
defaultLumaQuantizationTable = [Int16] -> QuantificationTable
forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock
    [16, 11, 10, 16,  24,  40,  51,  61
    ,12, 12, 14, 19,  26,  58,  60,  55
    ,14, 13, 16, 24,  40,  57,  69,  56
    ,14, 17, 22, 29,  51,  87,  80,  62
    ,18, 22, 37, 56,  68, 109, 103,  77
    ,24, 35, 55, 64,  81, 104, 113,  92
    ,49, 64, 78, 87, 103, 121, 120, 101
    ,72, 92, 95, 98, 112, 100, 103,  99
    ]

defaultChromaQuantizationTable :: QuantificationTable
defaultChromaQuantizationTable :: QuantificationTable
defaultChromaQuantizationTable = [Int16] -> QuantificationTable
forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock
    [17, 18, 24, 47, 99, 99, 99, 99
    ,18, 21, 26, 66, 99, 99, 99, 99
    ,24, 26, 56, 99, 99, 99, 99, 99
    ,47, 66, 99, 99, 99, 99, 99, 99
    ,99, 99, 99, 99, 99, 99, 99, 99
    ,99, 99, 99, 99, 99, 99, 99, 99
    ,99, 99, 99, 99, 99, 99, 99, 99
    ,99, 99, 99, 99, 99, 99, 99, 99
    ]

defaultDcLumaHuffmanTree :: HuffmanTree
defaultDcLumaHuffmanTree :: HuffmanTree
defaultDcLumaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultDcLumaHuffmanTable

-- | From the Table K.3 of ITU-81 (p153)

defaultDcLumaHuffmanTable :: HuffmanTable
defaultDcLumaHuffmanTable :: [[Word8]]
defaultDcLumaHuffmanTable =
    [ []
    , [0]
    , [1, 2, 3, 4, 5]
    , [6]
    , [7]
    , [8]
    , [9]
    , [10]
    , [11]
    , []
    , []
    , []
    , []
    , []
    , []
    , []
    ]

defaultDcChromaHuffmanTree :: HuffmanTree
defaultDcChromaHuffmanTree :: HuffmanTree
defaultDcChromaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultDcChromaHuffmanTable

-- | From the Table K.4 of ITU-81 (p153)

defaultDcChromaHuffmanTable :: HuffmanTable
defaultDcChromaHuffmanTable :: [[Word8]]
defaultDcChromaHuffmanTable = 
    [ []
    , [0, 1, 2]
    , [3]
    , [4]
    , [5]
    , [6]
    , [7]
    , [8]
    , [9]
    , [10]
    , [11]
    , []
    , []
    , []
    , []
    , []
    ]

defaultAcLumaHuffmanTree :: HuffmanTree
defaultAcLumaHuffmanTree :: HuffmanTree
defaultAcLumaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultAcLumaHuffmanTable

-- | From the Table K.5 of ITU-81 (p154)

defaultAcLumaHuffmanTable :: HuffmanTable
defaultAcLumaHuffmanTable :: [[Word8]]
defaultAcLumaHuffmanTable =
    [ []
    , [0x01, 0x02]
    , [0x03]
    , [0x00, 0x04, 0x11]
    , [0x05, 0x12, 0x21]
    , [0x31, 0x41]
    , [0x06, 0x13, 0x51, 0x61]
    , [0x07, 0x22, 0x71]
    , [0x14, 0x32, 0x81, 0x91, 0xA1]
    , [0x08, 0x23, 0x42, 0xB1, 0xC1]
    , [0x15, 0x52, 0xD1, 0xF0]
    , [0x24, 0x33, 0x62, 0x72]
    , []
    , []
    , [0x82]
    , [0x09, 0x0A, 0x16, 0x17, 0x18, 0x19, 0x1A, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x34, 0x35
      ,0x36, 0x37, 0x38, 0x39, 0x3A, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x53, 0x54
      ,0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x73
      ,0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x8A
      ,0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0x9A, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7
      ,0xA8, 0xA9, 0xAA, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7, 0xB8, 0xB9, 0xBA, 0xC2, 0xC3, 0xC4
      ,0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xCA, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9, 0xDA
      ,0xE1, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xEA, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5
      ,0xF6, 0xF7, 0xF8, 0xF9, 0xFA]
    ]

type HuffmanTable = [[Word8]]

defaultAcChromaHuffmanTree :: HuffmanTree
defaultAcChromaHuffmanTree :: HuffmanTree
defaultAcChromaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultAcChromaHuffmanTable 

defaultAcChromaHuffmanTable :: HuffmanTable
defaultAcChromaHuffmanTable :: [[Word8]]
defaultAcChromaHuffmanTable = 
    [ []
    , [0x00, 0x01]
    , [0x02]
    , [0x03, 0x11]
    , [0x04, 0x05, 0x21, 0x31]
    , [0x06, 0x12, 0x41, 0x51]
    , [0x07, 0x61, 0x71]
    , [0x13, 0x22, 0x32, 0x81]
    , [0x08, 0x14, 0x42, 0x91, 0xA1, 0xB1, 0xC1]
    , [0x09, 0x23, 0x33, 0x52, 0xF0]
    , [0x15, 0x62, 0x72, 0xD1]
    , [0x0A, 0x16, 0x24, 0x34]
    , []
    , [0xE1]
    , [0x25, 0xF1]
    , [ 0x17, 0x18, 0x19, 0x1A, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x35
      , 0x36, 0x37, 0x38, 0x39, 0x3A, 0x43, 0x44, 0x45, 0x46, 0x47
      , 0x48, 0x49, 0x4A, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59
      , 0x5A, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x73
      , 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x82, 0x83, 0x84
      , 0x85, 0x86, 0x87, 0x88, 0x89, 0x8A, 0x92, 0x93, 0x94, 0x95
      , 0x96, 0x97, 0x98, 0x99, 0x9A, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6
      , 0xA7, 0xA8, 0xA9, 0xAA, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7
      , 0xB8, 0xB9, 0xBA, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8
      , 0xC9, 0xCA, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9
      , 0xDA, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xEA
      , 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0xFA
      ]
    ]